Theory CZH_UCAT_Introduction
sectionβΉIntroductionβΊ
theory CZH_UCAT_Introduction
imports CZH_Elementary_Categories.CZH_ECAT_Introduction
begin
textβΉ
This article provides a formalization of further elements of the
theory of 1-categories without an additional structure.
More specifically, this article explores canonical universal
constructions \cite{noauthor_nlab_nodate}\footnote{
\url{https://ncatlab.org/nlab/show/universal+construction}
} and their properties.
βΊ
textβΉ\newpageβΊ
endTheory CZH_UCAT_Universal
sectionβΉUniversal arrowβΊ
theory CZH_UCAT_Universal
imports
CZH_UCAT_Introduction
CZH_Elementary_Categories.CZH_ECAT_FUNCT
CZH_Elementary_Categories.CZH_ECAT_Set
CZH_Elementary_Categories.CZH_ECAT_Hom
begin
subsectionβΉBackgroundβΊ
textβΉ
The following section is based, primarily, on the elements of the content
of Chapter III-1 in \cite{mac_lane_categories_2010}.
βΊ
subsectionβΉUniversal mapβΊ
textβΉ
The universal map is a convenience utility that allows treating
a part of the definition of the universal arrow as an arrow in the
category βΉSetβΊ.
βΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition umap_of :: "V β V β V β V β V β V"
where "umap_of π c r u d =
[
(Ξ»f'ββ©βHom (πβ¦HomDomβ¦) r d. πβ¦ArrMapβ¦β¦f'β¦ ββ©Aβπβ¦HomCodβ¦β u),
Hom (πβ¦HomDomβ¦) r d,
Hom (πβ¦HomCodβ¦) c (πβ¦ObjMapβ¦β¦dβ¦)
]β©β"
definition umap_fo :: "V β V β V β V β V β V"
where "umap_fo π c r u d = umap_of (op_cf π) c r u d"
textβΉComponents.βΊ
lemma (in is_functor) umap_of_components:
assumes "u : c β¦βπ
β πβ¦ObjMapβ¦β¦rβ¦"
shows "umap_of π c r u dβ¦ArrValβ¦ = (Ξ»f'ββ©βHom π r d. πβ¦ArrMapβ¦β¦f'β¦ ββ©Aβπ
β u)"
and "umap_of π c r u dβ¦ArrDomβ¦ = Hom π r d"
and "umap_of π c r u dβ¦ArrCodβ¦ = Hom π
c (πβ¦ObjMapβ¦β¦dβ¦)"
unfolding umap_of_def arr_field_simps
by (simp_all add: cat_cs_simps nat_omega_simps)
lemma (in is_functor) umap_fo_components:
assumes "u : πβ¦ObjMapβ¦β¦rβ¦ β¦βπ
β c"
shows "umap_fo π c r u dβ¦ArrValβ¦ = (Ξ»f'ββ©βHom π d r. u ββ©Aβπ
β πβ¦ArrMapβ¦β¦f'β¦)"
and "umap_fo π c r u dβ¦ArrDomβ¦ = Hom π d r"
and "umap_fo π c r u dβ¦ArrCodβ¦ = Hom π
(πβ¦ObjMapβ¦β¦dβ¦) c"
unfolding
umap_fo_def
is_functor.umap_of_components[
OF is_functor_op, unfolded cat_op_simps, OF assms
]
proof(rule vsv_eqI)
fix f' assume "f' ββ©β πβ©β (Ξ»f'ββ©βHom π d r. πβ¦ArrMapβ¦β¦f'β¦ ββ©Aβop_cat π
β u)"
then have f': "f' : d β¦βπβ r" by simp
then have πf': "πβ¦ArrMapβ¦β¦f'β¦ : πβ¦ObjMapβ¦β¦dβ¦ β¦βπ
β πβ¦ObjMapβ¦β¦rβ¦"
by (auto intro: cat_cs_intros)
from f' show
"(Ξ»f'ββ©βHom π d r. πβ¦ArrMapβ¦β¦f'β¦ ββ©Aβop_cat π
β u)β¦f'β¦ =
(Ξ»f'ββ©βHom π d r. u ββ©Aβπ
β πβ¦ArrMapβ¦β¦f'β¦)β¦f'β¦"
by (simp add: HomCod.op_cat_Comp[OF assms πf'])
qed simp_all
textβΉUniversal maps for the opposite functor.βΊ
lemma (in is_functor) op_umap_of[cat_op_simps]: "umap_of (op_cf π) = umap_fo π"
unfolding umap_fo_def by simp
lemma (in is_functor) op_umap_fo[cat_op_simps]: "umap_fo (op_cf π) = umap_of π"
unfolding umap_fo_def by (simp add: cat_op_simps)
lemmas [cat_op_simps] =
is_functor.op_umap_of
is_functor.op_umap_fo
subsubsectionβΉArrow valueβΊ
lemma umap_of_ArrVal_vsv[cat_cs_intros]: "vsv (umap_of π c r u dβ¦ArrValβ¦)"
unfolding umap_of_def arr_field_simps by (simp add: nat_omega_simps)
lemma umap_fo_ArrVal_vsv[cat_cs_intros]: "vsv (umap_fo π c r u dβ¦ArrValβ¦)"
unfolding umap_fo_def by (rule umap_of_ArrVal_vsv)
lemma (in is_functor) umap_of_ArrVal_vdomain:
assumes "u : c β¦βπ
β πβ¦ObjMapβ¦β¦rβ¦"
shows "πβ©β (umap_of π c r u dβ¦ArrValβ¦) = Hom π r d"
unfolding umap_of_components[OF assms] by simp
lemmas [cat_cs_simps] = is_functor.umap_of_ArrVal_vdomain
lemma (in is_functor) umap_fo_ArrVal_vdomain:
assumes "u : πβ¦ObjMapβ¦β¦rβ¦ β¦βπ
β c"
shows "πβ©β (umap_fo π c r u dβ¦ArrValβ¦) = Hom π d r"
unfolding umap_fo_components[OF assms] by simp
lemmas [cat_cs_simps] = is_functor.umap_fo_ArrVal_vdomain
lemma (in is_functor) umap_of_ArrVal_app:
assumes "f' : r β¦βπβ d" and "u : c β¦βπ
β πβ¦ObjMapβ¦β¦rβ¦"
shows "umap_of π c r u dβ¦ArrValβ¦β¦f'β¦ = πβ¦ArrMapβ¦β¦f'β¦ ββ©Aβπ
β u"
using assms(1) unfolding umap_of_components[OF assms(2)] by simp
lemmas [cat_cs_simps] = is_functor.umap_of_ArrVal_app
lemma (in is_functor) umap_fo_ArrVal_app:
assumes "f' : d β¦βπβ r" and "u : πβ¦ObjMapβ¦β¦rβ¦ β¦βπ
β c"
shows "umap_fo π c r u dβ¦ArrValβ¦β¦f'β¦ = u ββ©Aβπ
β πβ¦ArrMapβ¦β¦f'β¦"
proof-
from assms have "πβ¦ArrMapβ¦β¦f'β¦ : πβ¦ObjMapβ¦β¦dβ¦ β¦βπ
β πβ¦ObjMapβ¦β¦rβ¦"
by (auto intro: cat_cs_intros)
from this assms(2) have πf'[simp]:
"πβ¦ArrMapβ¦β¦f'β¦ ββ©Aβop_cat π
β u = u ββ©Aβπ
β πβ¦ArrMapβ¦β¦f'β¦"
by (simp add: cat_op_simps)
from
is_functor_axioms
is_functor.umap_of_ArrVal_app[
OF is_functor_op, unfolded cat_op_simps,
OF assms
]
show ?thesis
by (simp add: cat_op_simps cat_cs_simps)
qed
lemmas [cat_cs_simps] = is_functor.umap_fo_ArrVal_app
lemma (in is_functor) umap_of_ArrVal_vrange:
assumes "u : c β¦βπ
β πβ¦ObjMapβ¦β¦rβ¦"
shows "ββ©β (umap_of π c r u dβ¦ArrValβ¦) ββ©β Hom π
c (πβ¦ObjMapβ¦β¦dβ¦)"
proof(intro vsubset_antisym vsubsetI)
interpret vsv βΉumap_of π c r u dβ¦ArrValβ¦βΊ
unfolding umap_of_components[OF assms] by simp
fix g assume "g ββ©β ββ©β (umap_of π c r u dβ¦ArrValβ¦)"
then obtain f'
where g_def: "g = umap_of π c r u dβ¦ArrValβ¦β¦f'β¦"
and f': "f' ββ©β πβ©β (umap_of π c r u dβ¦ArrValβ¦)"
unfolding umap_of_components[OF assms] by auto
then have f': "f' : r β¦βπβ d"
unfolding umap_of_ArrVal_vdomain[OF assms] by simp
then have πf': "πβ¦ArrMapβ¦β¦f'β¦ : πβ¦ObjMapβ¦β¦rβ¦ β¦βπ
β πβ¦ObjMapβ¦β¦dβ¦"
by (auto intro!: cat_cs_intros)
have g_def: "g = πβ¦ArrMapβ¦β¦f'β¦ ββ©Aβπ
β u"
unfolding g_def umap_of_ArrVal_app[OF f' assms]..
from πf' assms show "g ββ©β Hom π
c (πβ¦ObjMapβ¦β¦dβ¦)"
unfolding g_def by (auto intro: cat_cs_intros)
qed
lemma (in is_functor) umap_fo_ArrVal_vrange:
assumes "u : πβ¦ObjMapβ¦β¦rβ¦ β¦βπ
β c"
shows "ββ©β (umap_fo π c r u dβ¦ArrValβ¦) ββ©β Hom π
(πβ¦ObjMapβ¦β¦dβ¦) c"
by
(
rule is_functor.umap_of_ArrVal_vrange[
OF is_functor_op, unfolded cat_op_simps, OF assms, folded umap_fo_def
]
)
subsubsectionβΉUniversal map is an arrow in the category βΉSetβΊβΊ
lemma (in is_functor) cf_arr_Set_umap_of:
assumes "category Ξ± π"
and "category Ξ± π
"
and r: "r ββ©β πβ¦Objβ¦"
and d: "d ββ©β πβ¦Objβ¦"
and u: "u : c β¦βπ
β πβ¦ObjMapβ¦β¦rβ¦"
shows "arr_Set Ξ± (umap_of π c r u d)"
proof(intro arr_SetI)
interpret HomDom: category Ξ± π by (rule assms(1))
interpret HomCod: category Ξ± π
by (rule assms(2))
note umap_of_components = umap_of_components[OF u]
from u d have c: "c ββ©β π
β¦Objβ¦" and πd: "(πβ¦ObjMapβ¦β¦dβ¦) ββ©β π
β¦Objβ¦"
by (auto intro: cat_cs_intros)
show "vfsequence (umap_of π c r u d)" unfolding umap_of_def by simp
show "vcard (umap_of π c r u d) = 3β©β"
unfolding umap_of_def by (simp add: nat_omega_simps)
from umap_of_ArrVal_vrange[OF u] show
"ββ©β (umap_of π c r u dβ¦ArrValβ¦) ββ©β umap_of π c r u dβ¦ArrCodβ¦"
unfolding umap_of_components by simp
from r d show "umap_of π c r u dβ¦ArrDomβ¦ ββ©β Vset Ξ±"
unfolding umap_of_components by (intro HomDom.cat_Hom_in_Vset)
from c πd show "umap_of π c r u dβ¦ArrCodβ¦ ββ©β Vset Ξ±"
unfolding umap_of_components by (intro HomCod.cat_Hom_in_Vset)
qed (auto simp: umap_of_components[OF u])
lemma (in is_functor) cf_arr_Set_umap_fo:
assumes "category Ξ± π"
and "category Ξ± π
"
and r: "r ββ©β πβ¦Objβ¦"
and d: "d ββ©β πβ¦Objβ¦"
and u: "u : πβ¦ObjMapβ¦β¦rβ¦ β¦βπ
β c"
shows "arr_Set Ξ± (umap_fo π c r u d)"
proof-
from assms(1) have π: "category Ξ± (op_cat π)"
by (auto intro: cat_cs_intros)
from assms(2) have π
: "category Ξ± (op_cat π
)"
by (auto intro: cat_cs_intros)
show ?thesis
by
(
rule
is_functor.cf_arr_Set_umap_of[
OF is_functor_op, unfolded cat_op_simps, OF π π
r d u
]
)
qed
lemma (in is_functor) cf_umap_of_is_arr:
assumes "category Ξ± π"
and "category Ξ± π
"
and "r ββ©β πβ¦Objβ¦"
and "d ββ©β πβ¦Objβ¦"
and "u : c β¦βπ
β πβ¦ObjMapβ¦β¦rβ¦"
shows "umap_of π c r u d : Hom π r d β¦βcat_Set Ξ±β Hom π
c (πβ¦ObjMapβ¦β¦dβ¦)"
proof(intro cat_Set_is_arrI)
show "arr_Set Ξ± (umap_of π c r u d)"
by (rule cf_arr_Set_umap_of[OF assms])
qed (simp_all add: umap_of_components[OF assms(5)])
lemma (in is_functor) cf_umap_of_is_arr':
assumes "category Ξ± π"
and "category Ξ± π
"
and "r ββ©β πβ¦Objβ¦"
and "d ββ©β πβ¦Objβ¦"
and "u : c β¦βπ
β πβ¦ObjMapβ¦β¦rβ¦"
and "A = Hom π r d"
and "B = Hom π
c (πβ¦ObjMapβ¦β¦dβ¦)"
and "β = cat_Set Ξ±"
shows "umap_of π c r u d : A β¦βββ B"
using assms(1-5) unfolding assms(6-8) by (rule cf_umap_of_is_arr)
lemmas [cat_cs_intros] = is_functor.cf_umap_of_is_arr'
lemma (in is_functor) cf_umap_fo_is_arr:
assumes "category Ξ± π"
and "category Ξ± π
"
and "r ββ©β πβ¦Objβ¦"
and "d ββ©β πβ¦Objβ¦"
and "u : πβ¦ObjMapβ¦β¦rβ¦ β¦βπ
β c"
shows "umap_fo π c r u d : Hom π d r β¦βcat_Set Ξ±β Hom π
(πβ¦ObjMapβ¦β¦dβ¦) c"
proof(intro cat_Set_is_arrI)
show "arr_Set Ξ± (umap_fo π c r u d)"
by (rule cf_arr_Set_umap_fo[OF assms])
qed (simp_all add: umap_fo_components[OF assms(5)])
lemma (in is_functor) cf_umap_fo_is_arr':
assumes "category Ξ± π"
and "category Ξ± π
"
and "r ββ©β πβ¦Objβ¦"
and "d ββ©β πβ¦Objβ¦"
and "u : πβ¦ObjMapβ¦β¦rβ¦ β¦βπ
β c"
and "A = Hom π d r"
and "B = Hom π
(πβ¦ObjMapβ¦β¦dβ¦) c"
and "β = cat_Set Ξ±"
shows "umap_fo π c r u d : A β¦βββ B"
using assms(1-5) unfolding assms(6-8) by (rule cf_umap_fo_is_arr)
lemmas [cat_cs_intros] = is_functor.cf_umap_fo_is_arr'
subsectionβΉUniversal arrow: definition and elementary propertiesβΊ
textβΉSee Chapter III-1 in \cite{mac_lane_categories_2010}.βΊ
definition universal_arrow_of :: "V β V β V β V β bool"
where "universal_arrow_of π c r u β·
(
r ββ©β πβ¦HomDomβ¦β¦Objβ¦ β§
u : c β¦βπβ¦HomCodβ¦β πβ¦ObjMapβ¦β¦rβ¦ β§
(
βr' u'.
r' ββ©β πβ¦HomDomβ¦β¦Objβ¦ βΆ
u' : c β¦βπβ¦HomCodβ¦β πβ¦ObjMapβ¦β¦r'β¦ βΆ
(β!f'. f' : r β¦βπβ¦HomDomβ¦β r' β§ u' = umap_of π c r u r'β¦ArrValβ¦β¦f'β¦)
)
)"
definition universal_arrow_fo :: "V β V β V β V β bool"
where "universal_arrow_fo π c r u β‘ universal_arrow_of (op_cf π) c r u"
textβΉRules.βΊ
mk_ide (in is_functor) rf
universal_arrow_of_def[where π=π, unfolded cf_HomDom cf_HomCod]
|intro universal_arrow_ofI|
|dest universal_arrow_ofD[dest]|
|elim universal_arrow_ofE[elim]|
lemma (in is_functor) universal_arrow_foI:
assumes "r ββ©β πβ¦Objβ¦"
and "u : πβ¦ObjMapβ¦β¦rβ¦ β¦βπ
β c"
and "βr' u'. β¦ r' ββ©β πβ¦Objβ¦; u' : πβ¦ObjMapβ¦β¦r'β¦ β¦βπ
β c β§ βΉ
β!f'. f' : r' β¦βπβ r β§ u' = umap_fo π c r u r'β¦ArrValβ¦β¦f'β¦"
shows "universal_arrow_fo π c r u"
by
(
simp add:
is_functor.universal_arrow_ofI
[
OF is_functor_op,
folded universal_arrow_fo_def,
unfolded cat_op_simps,
OF assms
]
)
lemma (in is_functor) universal_arrow_foD[dest]:
assumes "universal_arrow_fo π c r u"
shows "r ββ©β πβ¦Objβ¦"
and "u : πβ¦ObjMapβ¦β¦rβ¦ β¦βπ
β c"
and "βr' u'. β¦ r' ββ©β πβ¦Objβ¦; u' : πβ¦ObjMapβ¦β¦r'β¦ β¦βπ
β c β§ βΉ
β!f'. f' : r' β¦βπβ r β§ u' = umap_fo π c r u r'β¦ArrValβ¦β¦f'β¦"
by
(
auto simp:
is_functor.universal_arrow_ofD
[
OF is_functor_op,
folded universal_arrow_fo_def,
unfolded cat_op_simps,
OF assms
]
)
lemma (in is_functor) universal_arrow_foE[elim]:
assumes "universal_arrow_fo π c r u"
obtains "r ββ©β πβ¦Objβ¦"
and "u : πβ¦ObjMapβ¦β¦rβ¦ β¦βπ
β c"
and "βr' u'. β¦ r' ββ©β πβ¦Objβ¦; u' : πβ¦ObjMapβ¦β¦r'β¦ β¦βπ
β c β§ βΉ
β!f'. f' : r' β¦βπβ r β§ u' = umap_fo π c r u r'β¦ArrValβ¦β¦f'β¦"
using assms by (auto simp: universal_arrow_foD)
textβΉElementary properties.βΊ
lemma (in is_functor) op_cf_universal_arrow_of[cat_op_simps]:
"universal_arrow_of (op_cf π) c r u β· universal_arrow_fo π c r u"
unfolding universal_arrow_fo_def ..
lemma (in is_functor) op_cf_universal_arrow_fo[cat_op_simps]:
"universal_arrow_fo (op_cf π) c r u β· universal_arrow_of π c r u"
unfolding universal_arrow_fo_def cat_op_simps ..
lemmas (in is_functor) [cat_op_simps] =
is_functor.op_cf_universal_arrow_of
is_functor.op_cf_universal_arrow_fo
subsectionβΉUniquenessβΊ
textβΉ
The following properties are related to the uniqueness of the
universal arrow. These properties can be inferred from the content of
Chapter III-1 in \cite{mac_lane_categories_2010}.
βΊ
lemma (in is_functor) cf_universal_arrow_of_ex_is_arr_isomorphism:
assumes "universal_arrow_of π c r u" and "universal_arrow_of π c r' u'"
obtains f where "f : r β¦β©iβ©sβ©oβπβ r'" and "u' = umap_of π c r u r'β¦ArrValβ¦β¦fβ¦"
proof-
note ua1 = universal_arrow_ofD[OF assms(1)]
note ua2 = universal_arrow_ofD[OF assms(2)]
from ua1(1) have πr: "πβ¦CIdβ¦β¦rβ¦ : r β¦βπβ r" by (auto intro: cat_cs_intros)
from ua1(1) have "πβ¦ArrMapβ¦β¦πβ¦CIdβ¦β¦rβ¦β¦ = π
β¦CIdβ¦β¦πβ¦ObjMapβ¦β¦rβ¦β¦"
by (auto intro: cat_cs_intros)
with ua1(1,2) have u_def: "u = umap_of π c r u rβ¦ArrValβ¦β¦πβ¦CIdβ¦β¦rβ¦β¦"
unfolding umap_of_ArrVal_app[OF πr ua1(2)] by (auto simp: cat_cs_simps)
from ua2(1) have πr': "πβ¦CIdβ¦β¦r'β¦ : r' β¦βπβ r'" by (auto intro: cat_cs_intros)
from ua2(1) have "πβ¦ArrMapβ¦β¦πβ¦CIdβ¦β¦r'β¦β¦ = π
β¦CIdβ¦β¦πβ¦ObjMapβ¦β¦r'β¦β¦"
by (auto intro: cat_cs_intros)
with ua2(1,2) have u'_def: "u' = umap_of π c r' u' r'β¦ArrValβ¦β¦πβ¦CIdβ¦β¦r'β¦β¦"
unfolding umap_of_ArrVal_app[OF πr' ua2(2)] by (auto simp: cat_cs_simps)
from πr u_def universal_arrow_ofD(3)[OF assms(1) ua1(1,2)] have eq_CId_rI:
"β¦ f' : r β¦βπβ r; u = umap_of π c r u rβ¦ArrValβ¦β¦f'β¦ β§ βΉ f' = πβ¦CIdβ¦β¦rβ¦"
for f'
by blast
from πr' u'_def universal_arrow_ofD(3)[OF assms(2) ua2(1,2)] have eq_CId_r'I:
"β¦ f' : r' β¦βπβ r'; u' = umap_of π c r' u' r'β¦ArrValβ¦β¦f'β¦ β§ βΉ
f' = πβ¦CIdβ¦β¦r'β¦"
for f'
by blast
from ua1(3)[OF ua2(1,2)] obtain f
where f: "f : r β¦βπβ r'"
and u'_def: "u' = umap_of π c r u r'β¦ArrValβ¦β¦fβ¦"
and "g : r β¦βπβ r' βΉ u' = umap_of π c r u r'β¦ArrValβ¦β¦gβ¦ βΉ f = g"
for g
by metis
from ua2(3)[OF ua1(1,2)] obtain f'
where f': "f' : r' β¦βπβ r"
and u_def: "u = umap_of π c r' u' rβ¦ArrValβ¦β¦f'β¦"
and "g : r' β¦βπβ r βΉ u = umap_of π c r' u' rβ¦ArrValβ¦β¦gβ¦ βΉ f' = g"
for g
by metis
have "f : r β¦β©iβ©sβ©oβπβ r'"
proof(intro is_arr_isomorphismI is_inverseI)
show f: "f : r β¦βπβ r'" by (rule f)
show f': "f' : r' β¦βπβ r" by (rule f')
show "f : r β¦βπβ r'" by (rule f)
from f' have πf': "πβ¦ArrMapβ¦β¦f'β¦ : πβ¦ObjMapβ¦β¦r'β¦ β¦βπ
β πβ¦ObjMapβ¦β¦rβ¦"
by (auto intro: cat_cs_intros)
from f have πf: "πβ¦ArrMapβ¦β¦fβ¦ : πβ¦ObjMapβ¦β¦rβ¦ β¦βπ
β πβ¦ObjMapβ¦β¦r'β¦"
by (auto intro: cat_cs_intros)
note u'_def' = u'_def[symmetric, unfolded umap_of_ArrVal_app[OF f ua1(2)]]
and u_def' = u_def[symmetric, unfolded umap_of_ArrVal_app[OF f' ua2(2)]]
show "f' ββ©Aβπβ f = πβ¦CIdβ¦β¦rβ¦"
proof(rule eq_CId_rI)
from f f' show f'f: "f' ββ©Aβπβ f : r β¦βπβ r"
by (auto intro: cat_cs_intros)
from ua1(2) πf' πf show "u = umap_of π c r u rβ¦ArrValβ¦β¦f' ββ©Aβπβ fβ¦"
unfolding umap_of_ArrVal_app[OF f'f ua1(2)] cf_ArrMap_Comp[OF f' f]
by (simp add: HomCod.cat_Comp_assoc u'_def' u_def')
qed
show "f ββ©Aβπβ f' = πβ¦CIdβ¦β¦r'β¦"
proof(rule eq_CId_r'I)
from f f' show ff': "f ββ©Aβπβ f' : r' β¦βπβ r'"
by (auto intro: cat_cs_intros)
from ua2(2) πf' πf show "u' = umap_of π c r' u' r'β¦ArrValβ¦β¦f ββ©Aβπβ f'β¦"
unfolding umap_of_ArrVal_app[OF ff' ua2(2)] cf_ArrMap_Comp[OF f f']
by (simp add: HomCod.cat_Comp_assoc u'_def' u_def')
qed
qed
with u'_def that show ?thesis by auto
qed
lemma (in is_functor) cf_universal_arrow_fo_ex_is_arr_isomorphism:
assumes "universal_arrow_fo π c r u"
and "universal_arrow_fo π c r' u'"
obtains f where "f : r' β¦β©iβ©sβ©oβπβ r" and "u' = umap_fo π c r u r'β¦ArrValβ¦β¦fβ¦"
by
(
elim
is_functor.cf_universal_arrow_of_ex_is_arr_isomorphism[
OF is_functor_op, unfolded cat_op_simps, OF assms
]
)
lemma (in is_functor) cf_universal_arrow_of_unique:
assumes "universal_arrow_of π c r u"
and "universal_arrow_of π c r' u'"
shows "β!f'. f' : r β¦βπβ r' β§ u' = umap_of π c r u r'β¦ArrValβ¦β¦f'β¦"
proof-
note ua1 = universal_arrow_ofD[OF assms(1)]
note ua2 = universal_arrow_ofD[OF assms(2)]
from ua1(3)[OF ua2(1,2)] show ?thesis .
qed
lemma (in is_functor) cf_universal_arrow_fo_unique:
assumes "universal_arrow_fo π c r u"
and "universal_arrow_fo π c r' u'"
shows "β!f'. f' : r' β¦βπβ r β§ u' = umap_fo π c r u r'β¦ArrValβ¦β¦f'β¦"
proof-
note ua1 = universal_arrow_foD[OF assms(1)]
note ua2 = universal_arrow_foD[OF assms(2)]
from ua1(3)[OF ua2(1,2)] show ?thesis .
qed
lemma (in is_functor) cf_universal_arrow_of_is_arr_isomorphism:
assumes "universal_arrow_of π c r u"
and "universal_arrow_of π c r' u'"
and "f : r β¦βπβ r'"
and "u' = umap_of π c r u r'β¦ArrValβ¦β¦fβ¦"
shows "f : r β¦β©iβ©sβ©oβπβ r'"
proof-
from assms(3,4) cf_universal_arrow_of_unique[OF assms(1,2)] have eq:
"g : r β¦βπβ r' βΉ u' = umap_of π c r u r'β¦ArrValβ¦β¦gβ¦ βΉ f = g" for g
by blast
from assms(1,2) obtain f'
where iso_f': "f' : r β¦β©iβ©sβ©oβπβ r'"
and u'_def: "u' = umap_of π c r u r'β¦ArrValβ¦β¦f'β¦"
by (auto elim: cf_universal_arrow_of_ex_is_arr_isomorphism)
then have f': "f' : r β¦βπβ r'" by auto
from iso_f' show ?thesis unfolding eq[OF f' u'_def, symmetric].
qed
lemma (in is_functor) cf_universal_arrow_fo_is_arr_isomorphism:
assumes "universal_arrow_fo π c r u"
and "universal_arrow_fo π c r' u'"
and "f : r' β¦βπβ r"
and "u' = umap_fo π c r u r'β¦ArrValβ¦β¦fβ¦"
shows "f : r' β¦β©iβ©sβ©oβπβ r"
by
(
rule
is_functor.cf_universal_arrow_of_is_arr_isomorphism[
OF is_functor_op, unfolded cat_op_simps, OF assms
]
)
subsectionβΉUniversal natural transformationβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉ
The concept of the universal natural transformation is introduced for the
statement of the elements of a variant of Proposition 1 in Chapter III-2
in \cite{mac_lane_categories_2010}.
βΊ
definition ntcf_ua_of :: "V β V β V β V β V β V"
where "ntcf_ua_of Ξ± π c r u =
[
(Ξ»dββ©βπβ¦HomDomβ¦β¦Objβ¦. umap_of π c r u d),
Homβ©Oβ©.β©CβΞ±βπβ¦HomDomβ¦(r,-),
Homβ©Oβ©.β©CβΞ±βπβ¦HomCodβ¦(c,-) ββ©Cβ©F π,
πβ¦HomDomβ¦,
cat_Set Ξ±
]β©β"
definition ntcf_ua_fo :: "V β V β V β V β V β V"
where "ntcf_ua_fo Ξ± π c r u = ntcf_ua_of Ξ± (op_cf π) c r u"
textβΉComponents.βΊ
lemma ntcf_ua_of_components:
shows "ntcf_ua_of Ξ± π c r uβ¦NTMapβ¦ = (Ξ»dββ©βπβ¦HomDomβ¦β¦Objβ¦. umap_of π c r u d)"
and "ntcf_ua_of Ξ± π c r uβ¦NTDomβ¦ = Homβ©Oβ©.β©CβΞ±βπβ¦HomDomβ¦(r,-)"
and "ntcf_ua_of Ξ± π c r uβ¦NTCodβ¦ = Homβ©Oβ©.β©CβΞ±βπβ¦HomCodβ¦(c,-) ββ©Cβ©F π"
and "ntcf_ua_of Ξ± π c r uβ¦NTDGDomβ¦ = πβ¦HomDomβ¦"
and "ntcf_ua_of Ξ± π c r uβ¦NTDGCodβ¦ = cat_Set Ξ±"
unfolding ntcf_ua_of_def nt_field_simps by (simp_all add: nat_omega_simps)
lemma ntcf_ua_fo_components:
shows "ntcf_ua_fo Ξ± π c r uβ¦NTMapβ¦ = (Ξ»dββ©βπβ¦HomDomβ¦β¦Objβ¦. umap_fo π c r u d)"
and "ntcf_ua_fo Ξ± π c r uβ¦NTDomβ¦ = Homβ©Oβ©.β©CβΞ±βop_cat (πβ¦HomDomβ¦)(r,-)"
and "ntcf_ua_fo Ξ± π c r uβ¦NTCodβ¦ =
Homβ©Oβ©.β©CβΞ±βop_cat (πβ¦HomCodβ¦)(c,-) ββ©Cβ©F op_cf π"
and "ntcf_ua_fo Ξ± π c r uβ¦NTDGDomβ¦ = op_cat (πβ¦HomDomβ¦)"
and "ntcf_ua_fo Ξ± π c r uβ¦NTDGCodβ¦ = cat_Set Ξ±"
unfolding ntcf_ua_fo_def ntcf_ua_of_components umap_fo_def cat_op_simps
by simp_all
context is_functor
begin
lemmas ntcf_ua_of_components' =
ntcf_ua_of_components[where Ξ±=Ξ± and π=π, unfolded cat_cs_simps]
lemmas [cat_cs_simps] = ntcf_ua_of_components'(2-5)
lemma ntcf_ua_fo_components':
assumes "c ββ©β π
β¦Objβ¦" and "r ββ©β πβ¦Objβ¦"
shows "ntcf_ua_fo Ξ± π c r uβ¦NTMapβ¦ = (Ξ»dββ©βπβ¦Objβ¦. umap_fo π c r u d)"
and [cat_cs_simps]:
"ntcf_ua_fo Ξ± π c r uβ¦NTDomβ¦ = Homβ©Oβ©.β©CβΞ±βπ(-,r)"
and [cat_cs_simps]:
"ntcf_ua_fo Ξ± π c r uβ¦NTCodβ¦ = Homβ©Oβ©.β©CβΞ±βπ
(-,c) ββ©Cβ©F op_cf π"
and [cat_cs_simps]: "ntcf_ua_fo Ξ± π c r uβ¦NTDGDomβ¦ = op_cat π"
and [cat_cs_simps]: "ntcf_ua_fo Ξ± π c r uβ¦NTDGCodβ¦ = cat_Set Ξ±"
unfolding
ntcf_ua_fo_components cat_cs_simps
HomDom.cat_op_cat_cf_Hom_snd[OF assms(2)]
HomCod.cat_op_cat_cf_Hom_snd[OF assms(1)]
by simp_all
end
lemmas [cat_cs_simps] =
is_functor.ntcf_ua_of_components'(2-5)
is_functor.ntcf_ua_fo_components'(2-5)
subsubsectionβΉNatural transformation mapβΊ
mk_VLambda (in is_functor)
ntcf_ua_of_components(1)[where Ξ±=Ξ± and π=π, unfolded cf_HomDom]
|vsv ntcf_ua_of_NTMap_vsv|
|vdomain ntcf_ua_of_NTMap_vdomain|
|app ntcf_ua_of_NTMap_app|
context is_functor
begin
context
fixes c r
assumes r: "r ββ©β πβ¦Objβ¦" and c: "c ββ©β π
β¦Objβ¦"
begin
mk_VLambda ntcf_ua_fo_components'(1)[OF c r]
|vsv ntcf_ua_fo_NTMap_vsv|
|vdomain ntcf_ua_fo_NTMap_vdomain|
|app ntcf_ua_fo_NTMap_app|
end
end
lemmas [cat_cs_intros] =
is_functor.ntcf_ua_fo_NTMap_vsv
is_functor.ntcf_ua_of_NTMap_vsv
lemmas [cat_cs_simps] =
is_functor.ntcf_ua_fo_NTMap_vdomain
is_functor.ntcf_ua_fo_NTMap_app
is_functor.ntcf_ua_of_NTMap_vdomain
is_functor.ntcf_ua_of_NTMap_app
lemma (in is_functor) ntcf_ua_of_NTMap_vrange:
assumes "category Ξ± π"
and "category Ξ± π
"
and "r ββ©β πβ¦Objβ¦"
and "u : c β¦βπ
β πβ¦ObjMapβ¦β¦rβ¦"
shows "ββ©β (ntcf_ua_of Ξ± π c r uβ¦NTMapβ¦) ββ©β cat_Set Ξ±β¦Arrβ¦"
proof(rule vsv.vsv_vrange_vsubset, unfold ntcf_ua_of_NTMap_vdomain)
show "vsv (ntcf_ua_of Ξ± π c r uβ¦NTMapβ¦)" by (rule ntcf_ua_of_NTMap_vsv)
fix d assume prems: "d ββ©β πβ¦Objβ¦"
with category_cat_Set is_functor_axioms assms show
"ntcf_ua_of Ξ± π c r uβ¦NTMapβ¦β¦dβ¦ ββ©β cat_Set Ξ±β¦Arrβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
subsubsectionβΉCommutativity of the universal maps and βΉhomβΊ-functionsβΊ
lemma (in is_functor) cf_umap_of_cf_hom_commute:
assumes "category Ξ± π"
and "category Ξ± π
"
and "c ββ©β π
β¦Objβ¦"
and "r ββ©β πβ¦Objβ¦"
and "u : c β¦βπ
β πβ¦ObjMapβ¦β¦rβ¦"
and "f : a β¦βπβ b"
shows
"umap_of π c r u b ββ©Aβcat_Set Ξ±β cf_hom π [πβ¦CIdβ¦β¦rβ¦, f]β©β =
cf_hom π
[π
β¦CIdβ¦β¦cβ¦, πβ¦ArrMapβ¦β¦fβ¦]β©β ββ©Aβcat_Set Ξ±β umap_of π c r u a"
(is βΉ?uof_b ββ©Aβcat_Set Ξ±β ?rf = ?cf ββ©Aβcat_Set Ξ±β ?uof_aβΊ)
proof-
from is_functor_axioms category_cat_Set assms(1,2,4-6) have b_rf:
"?uof_b ββ©Aβcat_Set Ξ±β ?rf : Hom π r a β¦βcat_Set Ξ±β Hom π
c (πβ¦ObjMapβ¦β¦bβ¦)"
by (cs_concl cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros)
from is_functor_axioms category_cat_Set assms(1,2,4-6) have cf_a:
"?cf ββ©Aβcat_Set Ξ±β ?uof_a : Hom π r a β¦βcat_Set Ξ±β Hom π
c (πβ¦ObjMapβ¦β¦bβ¦)"
by (cs_concl cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros)
show ?thesis
proof(rule arr_Set_eqI[of Ξ±])
from b_rf show arr_Set_b_rf: "arr_Set Ξ± (?uof_b ββ©Aβcat_Set Ξ±β ?rf)"
by (auto dest: cat_Set_is_arrD(1))
from b_rf have dom_lhs:
"πβ©β ((?uof_b ββ©Aβcat_Set Ξ±β ?rf)β¦ArrValβ¦) = Hom π r a"
by (cs_concl cs_simp: cat_cs_simps)+
from cf_a show arr_Set_cf_a: "arr_Set Ξ± (?cf ββ©Aβcat_Set Ξ±β ?uof_a)"
by (auto dest: cat_Set_is_arrD(1))
from cf_a have dom_rhs:
"πβ©β ((?cf ββ©Aβcat_Set Ξ±β ?uof_a)β¦ArrValβ¦) = Hom π r a"
by (cs_concl cs_simp: cat_cs_simps)
show "(?uof_b ββ©Aβcat_Set Ξ±β ?rf)β¦ArrValβ¦ = (?cf ββ©Aβcat_Set Ξ±β ?uof_a)β¦ArrValβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
fix q assume "q : r β¦βπβ a"
with is_functor_axioms category_cat_Set assms show
"(?uof_b ββ©Aβcat_Set Ξ±β ?rf)β¦ArrValβ¦β¦qβ¦ =
(?cf ββ©Aβcat_Set Ξ±β ?uof_a)β¦ArrValβ¦β¦qβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
qed (use arr_Set_b_rf arr_Set_cf_a in auto)
qed (use b_rf cf_a in βΉcs_concl cs_simp: cat_cs_simpsβΊ)+
qed
lemma cf_umap_of_cf_hom_unit_commute:
assumes "category Ξ± β"
and "category Ξ± π"
and "π : β β¦β¦β©CβΞ±β π"
and "π : π β¦β¦β©CβΞ±β β"
and "Ξ· : cf_id β β¦β©Cβ©F π ββ©Cβ©F π : β β¦β¦β©CβΞ±β β"
and "g : c' β¦βββ c"
and "f : d β¦βπβ d'"
shows
"umap_of π c' (πβ¦ObjMapβ¦β¦c'β¦) (Ξ·β¦NTMapβ¦β¦c'β¦) d' ββ©Aβcat_Set Ξ±β
cf_hom π [πβ¦ArrMapβ¦β¦gβ¦, f]β©β =
cf_hom β [g, πβ¦ArrMapβ¦β¦fβ¦]β©β ββ©Aβcat_Set Ξ±β
umap_of π c (πβ¦ObjMapβ¦β¦cβ¦) (Ξ·β¦NTMapβ¦β¦cβ¦) d"
(is βΉ?uof_c'd' ββ©Aβcat_Set Ξ±β ?πgf = ?gπf ββ©Aβcat_Set Ξ±β ?uof_cdβΊ)
proof-
interpret Ξ·: is_ntcf Ξ± β β βΉcf_id ββΊ βΉπ ββ©Cβ©F πβΊ Ξ· by (rule assms(5))
from assms have c'd'_πgf: "?uof_c'd' ββ©Aβcat_Set Ξ±β ?πgf :
Hom π (πβ¦ObjMapβ¦β¦cβ¦) d β¦βcat_Set Ξ±β Hom β c' (πβ¦ObjMapβ¦β¦d'β¦)"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
then have dom_lhs:
"πβ©β ((?uof_c'd' ββ©Aβcat_Set Ξ±β ?πgf)β¦ArrValβ¦) = Hom π (πβ¦ObjMapβ¦β¦cβ¦) d"
by (cs_concl cs_simp: cat_cs_simps)
from assms have gπf_cd: "?gπf ββ©Aβcat_Set Ξ±β ?uof_cd :
Hom π (πβ¦ObjMapβ¦β¦cβ¦) d β¦βcat_Set Ξ±β Hom β c' (πβ¦ObjMapβ¦β¦d'β¦)"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
then have dom_rhs:
"πβ©β ((?gπf ββ©Aβcat_Set Ξ±β ?uof_cd)β¦ArrValβ¦) = Hom π (πβ¦ObjMapβ¦β¦cβ¦) d"
by (cs_concl cs_simp: cat_cs_simps)
show ?thesis
proof(rule arr_Set_eqI[of Ξ±])
from c'd'_πgf show arr_Set_c'd'_πgf:
"arr_Set Ξ± (?uof_c'd' ββ©Aβcat_Set Ξ±β ?πgf)"
by (auto dest: cat_Set_is_arrD(1))
from gπf_cd show arr_Set_gπf_cd:
"arr_Set Ξ± (?gπf ββ©Aβcat_Set Ξ±β ?uof_cd)"
by (auto dest: cat_Set_is_arrD(1))
show
"(?uof_c'd' ββ©Aβcat_Set Ξ±β ?πgf)β¦ArrValβ¦ =
(?gπf ββ©Aβcat_Set Ξ±β ?uof_cd)β¦ArrValβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
fix h assume prems: "h : πβ¦ObjMapβ¦β¦cβ¦ β¦βπβ d"
from Ξ·.ntcf_Comp_commute[OF assms(6)] assms have [cat_cs_simps]:
"Ξ·β¦NTMapβ¦β¦cβ¦ ββ©Aβββ g = πβ¦ArrMapβ¦β¦πβ¦ArrMapβ¦β¦gβ¦β¦ ββ©Aβββ Ξ·β¦NTMapβ¦β¦c'β¦"
by (cs_prems cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
from assms prems show
"(?uof_c'd' ββ©Aβcat_Set Ξ±β ?πgf)β¦ArrValβ¦β¦hβ¦ =
(?gπf ββ©Aβcat_Set Ξ±β ?uof_cd)β¦ArrValβ¦β¦hβ¦"
by
(
cs_concl
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
cs_simp: cat_cs_simps
)
qed (use arr_Set_c'd'_πgf arr_Set_gπf_cd in auto)
qed (use c'd'_πgf gπf_cd in βΉcs_concl cs_simp: cat_cs_simpsβΊ)+
qed
subsubsectionβΉUniversal natural transformation is a natural transformationβΊ
lemma (in is_functor) cf_ntcf_ua_of_is_ntcf:
assumes "r ββ©β πβ¦Objβ¦"
and "u : c β¦βπ
β πβ¦ObjMapβ¦β¦rβ¦"
shows "ntcf_ua_of Ξ± π c r u :
Homβ©Oβ©.β©CβΞ±βπ(r,-) β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±βπ
(c,-) ββ©Cβ©F π : π β¦β¦β©CβΞ±β cat_Set Ξ±"
proof(intro is_ntcfI')
let ?ua = βΉntcf_ua_of Ξ± π c r uβΊ
show "vfsequence (ntcf_ua_of Ξ± π c r u)" unfolding ntcf_ua_of_def by simp
show "vcard ?ua = 5β©β" unfolding ntcf_ua_of_def by (simp add: nat_omega_simps)
from assms(1) show "Homβ©Oβ©.β©CβΞ±βπ(r,-) : π β¦β¦β©CβΞ±β cat_Set Ξ±"
by (cs_concl cs_intro: cat_cs_intros)
from is_functor_axioms assms(2) show
"Homβ©Oβ©.β©CβΞ±βπ
(c,-) ββ©Cβ©F π : π β¦β¦β©CβΞ±β cat_Set Ξ±"
by (cs_concl cs_intro: cat_cs_intros)
from is_functor_axioms assms show "πβ©β (?uaβ¦NTMapβ¦) = πβ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps)
show "?uaβ¦NTMapβ¦β¦aβ¦ :
Homβ©Oβ©.β©CβΞ±βπ(r,-)β¦ObjMapβ¦β¦aβ¦ β¦βcat_Set Ξ±β (Homβ©Oβ©.β©CβΞ±βπ
(c,-) ββ©Cβ©F π)β¦ObjMapβ¦β¦aβ¦"
if "a ββ©β πβ¦Objβ¦" for a
using is_functor_axioms assms that
by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
show "?uaβ¦NTMapβ¦β¦bβ¦ ββ©Aβcat_Set Ξ±β Homβ©Oβ©.β©CβΞ±βπ(r,-)β¦ArrMapβ¦β¦fβ¦ =
(Homβ©Oβ©.β©CβΞ±βπ
(c,-) ββ©Cβ©F π)β¦ArrMapβ¦β¦fβ¦ ββ©Aβcat_Set Ξ±β ?uaβ¦NTMapβ¦β¦aβ¦"
if "f : a β¦βπβ b" for a b f
using is_functor_axioms assms that
by
(
cs_concl
cs_simp: cf_umap_of_cf_hom_commute cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros
)
qed (auto simp: ntcf_ua_of_components cat_cs_simps)
lemma (in is_functor) cf_ntcf_ua_fo_is_ntcf:
assumes "r ββ©β πβ¦Objβ¦" and "u : πβ¦ObjMapβ¦β¦rβ¦ β¦βπ
β c"
shows "ntcf_ua_fo Ξ± π c r u :
Homβ©Oβ©.β©CβΞ±βπ(-,r) β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±βπ
(-,c) ββ©Cβ©F op_cf π :
op_cat π β¦β¦β©CβΞ±β cat_Set Ξ±"
proof-
from assms(2) have c: "c ββ©β π
β¦Objβ¦" by auto
show ?thesis
by
(
rule is_functor.cf_ntcf_ua_of_is_ntcf
[
OF is_functor_op,
unfolded cat_op_simps,
OF assms(1,2),
unfolded
HomDom.cat_op_cat_cf_Hom_snd[OF assms(1)]
HomCod.cat_op_cat_cf_Hom_snd[OF c]
ntcf_ua_fo_def[symmetric]
]
)
qed
subsubsectionβΉUniversal natural transformation and universal arrowβΊ
textβΉ
The lemmas in this subsection correspond to
variants of elements of Proposition 1 in Chapter III-2 in
\cite{mac_lane_categories_2010}.
βΊ
lemma (in is_functor) cf_ntcf_ua_of_is_iso_ntcf:
assumes "universal_arrow_of π c r u"
shows "ntcf_ua_of Ξ± π c r u :
Homβ©Oβ©.β©CβΞ±βπ(r,-) β¦β©Cβ©Fβ©.β©iβ©sβ©o Homβ©Oβ©.β©CβΞ±βπ
(c,-) ββ©Cβ©F π : π β¦β¦β©CβΞ±β cat_Set Ξ±"
proof-
have r: "r ββ©β πβ¦Objβ¦"
and u: "u : c β¦βπ
β πβ¦ObjMapβ¦β¦rβ¦"
and bij: "βr' u'.
β¦
r' ββ©β πβ¦Objβ¦;
u' : c β¦βπ
β πβ¦ObjMapβ¦β¦r'β¦
β§ βΉ β!f'. f' : r β¦βπβ r' β§ u' = umap_of π c r u r'β¦ArrValβ¦β¦f'β¦"
by (auto intro!: universal_arrow_ofD[OF assms(1)])
show ?thesis
proof(intro is_iso_ntcfI)
show "ntcf_ua_of Ξ± π c r u :
Homβ©Oβ©.β©CβΞ±βπ(r,-) β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±βπ
(c,-) ββ©Cβ©F π : π β¦β¦β©CβΞ±β cat_Set Ξ±"
by (rule cf_ntcf_ua_of_is_ntcf[OF r u])
fix a assume prems: "a ββ©β πβ¦Objβ¦"
from is_functor_axioms prems r u have [simp]:
"umap_of π c r u a : Hom π r a β¦βcat_Set Ξ±β Hom π
c (πβ¦ObjMapβ¦β¦aβ¦)"
by (cs_concl cs_intro: cat_cs_intros)
then have dom: "πβ©β (umap_of π c r u aβ¦ArrValβ¦) = Hom π r a"
by (cs_concl cs_simp: cat_cs_simps)
have "umap_of π c r u a : Hom π r a β¦β©iβ©sβ©oβcat_Set Ξ±β Hom π
c (πβ¦ObjMapβ¦β¦aβ¦)"
proof(intro cat_Set_is_arr_isomorphismI, unfold dom)
show umof_a: "v11 (umap_of π c r u aβ¦ArrValβ¦)"
proof(intro vsv.vsv_valeq_v11I, unfold dom in_Hom_iff)
fix g f assume prems':
"g : r β¦βπβ a"
"f : r β¦βπβ a"
"umap_of π c r u aβ¦ArrValβ¦β¦gβ¦ = umap_of π c r u aβ¦ArrValβ¦β¦fβ¦"
from is_functor_axioms r u prems'(1) have πg:
"πβ¦ArrMapβ¦β¦gβ¦ ββ©Aβπ
β u : c β¦βπ
β πβ¦ObjMapβ¦β¦aβ¦"
by (cs_concl cs_intro: cat_cs_intros)
from bij[OF prems πg] have unique:
"β¦
f' : r β¦βπβ a;
πβ¦ArrMapβ¦β¦gβ¦ ββ©Aβπ
β u = umap_of π c r u aβ¦ArrValβ¦β¦f'β¦
β§ βΉ g = f'"
for f' by (metis prems'(1) u umap_of_ArrVal_app)
from is_functor_axioms prems'(1,2) u have πg_u:
"πβ¦ArrMapβ¦β¦gβ¦ ββ©Aβπ
β u = umap_of π c r u aβ¦ArrValβ¦β¦fβ¦"
by (cs_concl cs_simp: prems'(3)[symmetric] cat_cs_simps)
show "g = f" by (rule unique[OF prems'(2) πg_u])
qed (auto simp: cat_cs_simps cat_cs_intros)
interpret umof_a: v11 βΉumap_of π c r u aβ¦ArrValβ¦βΊ by (rule umof_a)
show "ββ©β (umap_of π c r u aβ¦ArrValβ¦) = Hom π
c (πβ¦ObjMapβ¦β¦aβ¦)"
proof(intro vsubset_antisym)
from u show "ββ©β (umap_of π c r u aβ¦ArrValβ¦) ββ©β Hom π
c (πβ¦ObjMapβ¦β¦aβ¦)"
by (rule umap_of_ArrVal_vrange)
show "Hom π
c (πβ¦ObjMapβ¦β¦aβ¦) ββ©β ββ©β (umap_of π c r u aβ¦ArrValβ¦)"
proof(rule vsubsetI, unfold in_Hom_iff )
fix f assume prems': "f : c β¦βπ
β πβ¦ObjMapβ¦β¦aβ¦"
from bij[OF prems prems'] obtain f'
where f': "f' : r β¦βπβ a"
and f_def: "f = umap_of π c r u aβ¦ArrValβ¦β¦f'β¦"
by auto
from is_functor_axioms prems prems' u f' have
"f' ββ©β πβ©β (umap_of π c r u aβ¦ArrValβ¦)"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from this show "f ββ©β ββ©β (umap_of π c r u aβ¦ArrValβ¦)"
unfolding f_def by (rule umof_a.vsv_vimageI2)
qed
qed
qed simp_all
from is_functor_axioms prems r u this show
"ntcf_ua_of Ξ± π c r uβ¦NTMapβ¦β¦aβ¦ :
Homβ©Oβ©.β©CβΞ±βπ(r,-)β¦ObjMapβ¦β¦aβ¦ β¦β©iβ©sβ©oβcat_Set Ξ±β
(Homβ©Oβ©.β©CβΞ±βπ
(c,-) ββ©Cβ©F π)β¦ObjMapβ¦β¦aβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros
)
qed
qed
lemmas [cat_cs_intros] = is_functor.cf_ntcf_ua_of_is_iso_ntcf
lemma (in is_functor) cf_ntcf_ua_fo_is_iso_ntcf:
assumes "universal_arrow_fo π c r u"
shows "ntcf_ua_fo Ξ± π c r u :
Homβ©Oβ©.β©CβΞ±βπ(-,r) β¦β©Cβ©Fβ©.β©iβ©sβ©o Homβ©Oβ©.β©CβΞ±βπ
(-,c) ββ©Cβ©F op_cf π :
op_cat π β¦β¦β©CβΞ±β cat_Set Ξ±"
proof-
from universal_arrow_foD[OF assms] have r: "r ββ©β πβ¦Objβ¦" and c: "c ββ©β π
β¦Objβ¦"
by auto
show ?thesis
by
(
rule is_functor.cf_ntcf_ua_of_is_iso_ntcf
[
OF is_functor_op,
unfolded cat_op_simps,
OF assms,
unfolded
HomDom.cat_op_cat_cf_Hom_snd[OF r]
HomCod.cat_op_cat_cf_Hom_snd[OF c]
ntcf_ua_fo_def[symmetric]
]
)
qed
lemmas [cat_cs_intros] = is_functor.cf_ntcf_ua_fo_is_iso_ntcf
lemma (in is_functor) cf_ua_of_if_ntcf_ua_of_is_iso_ntcf:
assumes "r ββ©β πβ¦Objβ¦"
and "u : c β¦βπ
β πβ¦ObjMapβ¦β¦rβ¦"
and "ntcf_ua_of Ξ± π c r u :
Homβ©Oβ©.β©CβΞ±βπ(r,-) β¦β©Cβ©Fβ©.β©iβ©sβ©o Homβ©Oβ©.β©CβΞ±βπ
(c,-) ββ©Cβ©F π : π β¦β¦β©CβΞ±β cat_Set Ξ±"
shows "universal_arrow_of π c r u"
proof(rule universal_arrow_ofI)
interpret ua_of_u: is_iso_ntcf
Ξ±
π
βΉcat_Set Ξ±βΊ
βΉHomβ©Oβ©.β©CβΞ±βπ(r,-)βΊ
βΉHomβ©Oβ©.β©CβΞ±βπ
(c,-) ββ©Cβ©F πβΊ
βΉntcf_ua_of Ξ± π c r uβΊ
by (rule assms(3))
fix r' u' assume prems: "r' ββ©β πβ¦Objβ¦" "u' : c β¦βπ
β πβ¦ObjMapβ¦β¦r'β¦"
have "ntcf_ua_of Ξ± π c r uβ¦NTMapβ¦β¦r'β¦ :
Homβ©Oβ©.β©CβΞ±βπ(r,-)β¦ObjMapβ¦β¦r'β¦ β¦β©iβ©sβ©oβcat_Set Ξ±β
(Homβ©Oβ©.β©CβΞ±βπ
(c,-) ββ©Cβ©F π)β¦ObjMapβ¦β¦r'β¦"
by (rule is_iso_ntcf.iso_ntcf_is_arr_isomorphism[OF assms(3) prems(1)])
from this is_functor_axioms assms(1-2) prems have uof_r':
"umap_of π c r u r' : Hom π r r' β¦β©iβ©sβ©oβcat_Set Ξ±β Hom π
c (πβ¦ObjMapβ¦β¦r'β¦)"
by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)
note uof_r' = cat_Set_is_arr_isomorphismD[OF uof_r']
interpret uof_r': v11 βΉumap_of π c r u r'β¦ArrValβ¦βΊ by (rule uof_r'(2))
from
uof_r'.v11_vrange_ex1_eq[
THEN iffD1, unfolded uof_r'(3,4) in_Hom_iff, OF prems(2)
]
show "β!f'. f' : r β¦βπβ r' β§ u' = umap_of π c r u r'β¦ArrValβ¦β¦f'β¦"
by metis
qed (intro assms)+
lemma (in is_functor) cf_ua_fo_if_ntcf_ua_fo_is_iso_ntcf:
assumes "r ββ©β πβ¦Objβ¦"
and "u : πβ¦ObjMapβ¦β¦rβ¦ β¦βπ
β c"
and "ntcf_ua_fo Ξ± π c r u :
Homβ©Oβ©.β©CβΞ±βπ(-,r) β¦β©Cβ©Fβ©.β©iβ©sβ©o Homβ©Oβ©.β©CβΞ±βπ
(-,c) ββ©Cβ©F op_cf π :
op_cat π β¦β¦β©CβΞ±β cat_Set Ξ±"
shows "universal_arrow_fo π c r u"
proof-
from assms(2) have c: "c ββ©β π
β¦Objβ¦" by auto
show ?thesis
by
(
rule is_functor.cf_ua_of_if_ntcf_ua_of_is_iso_ntcf
[
OF is_functor_op,
unfolded cat_op_simps,
OF assms(1,2),
unfolded
HomDom.cat_op_cat_cf_Hom_snd[OF assms(1)]
HomCod.cat_op_cat_cf_Hom_snd[OF c]
ntcf_ua_fo_def[symmetric],
OF assms(3)
]
)
qed
lemma (in is_functor) cf_universal_arrow_of_if_is_iso_ntcf:
assumes "r ββ©β πβ¦Objβ¦"
and "c ββ©β π
β¦Objβ¦"
and "Ο :
Homβ©Oβ©.β©CβΞ±βπ(r,-) β¦β©Cβ©Fβ©.β©iβ©sβ©o Homβ©Oβ©.β©CβΞ±βπ
(c,-) ββ©Cβ©F π :
π β¦β¦β©CβΞ±β cat_Set Ξ±"
shows "universal_arrow_of π c r (Οβ¦NTMapβ¦β¦rβ¦β¦ArrValβ¦β¦πβ¦CIdβ¦β¦rβ¦β¦)"
(is βΉuniversal_arrow_of π c r ?uβΊ)
proof-
interpret Ο: is_iso_ntcf
Ξ± π βΉcat_Set Ξ±βΊ βΉHomβ©Oβ©.β©CβΞ±βπ(r,-)βΊ βΉHomβ©Oβ©.β©CβΞ±βπ
(c,-) ββ©Cβ©F πβΊ Ο
by (rule assms(3))
show ?thesis
proof(intro universal_arrow_ofI assms)
from assms(1,2) show u: "?u : c β¦βπ
β πβ¦ObjMapβ¦β¦rβ¦"
by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
fix r' u' assume prems: "r' ββ©β πβ¦Objβ¦" "u' : c β¦βπ
β πβ¦ObjMapβ¦β¦r'β¦"
have Οr'_ArrVal_app[symmetric, cat_cs_simps]:
"Οβ¦NTMapβ¦β¦r'β¦β¦ArrValβ¦β¦f'β¦ =
πβ¦ArrMapβ¦β¦f'β¦ ββ©Aβπ
β Οβ¦NTMapβ¦β¦rβ¦β¦ArrValβ¦β¦πβ¦CIdβ¦β¦rβ¦β¦"
if "f' : r β¦βπβ r'" for f'
proof-
have "Οβ¦NTMapβ¦β¦r'β¦ ββ©Aβcat_Set Ξ±β Homβ©Oβ©.β©CβΞ±βπ(r,-)β¦ArrMapβ¦β¦f'β¦ =
(Homβ©Oβ©.β©CβΞ±βπ
(c,-) ββ©Cβ©F π)β¦ArrMapβ¦β¦f'β¦ ββ©Aβcat_Set Ξ±β Οβ¦NTMapβ¦β¦rβ¦"
using that by (intro Ο.ntcf_Comp_commute)
then have
"Οβ¦NTMapβ¦β¦r'β¦ ββ©Aβcat_Set Ξ±β cf_hom π [πβ¦CIdβ¦β¦rβ¦, f']β©β =
cf_hom π
[π
β¦CIdβ¦β¦cβ¦, πβ¦ArrMapβ¦β¦f'β¦]β©β ββ©Aβcat_Set Ξ±β Οβ¦NTMapβ¦β¦rβ¦"
using assms(1,2) that prems
by (cs_prems cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
then have
"(Οβ¦NTMapβ¦β¦r'β¦ ββ©Aβcat_Set Ξ±β
cf_hom π [πβ¦CIdβ¦β¦rβ¦, f']β©β)β¦ArrValβ¦β¦πβ¦CIdβ¦β¦rβ¦β¦ =
(cf_hom π
[π
β¦CIdβ¦β¦cβ¦, πβ¦ArrMapβ¦β¦f'β¦]β©β ββ©Aβcat_Set Ξ±β
Οβ¦NTMapβ¦β¦rβ¦)β¦ArrValβ¦β¦πβ¦CIdβ¦β¦rβ¦β¦"
by simp
from this assms(1,2) u that show ?thesis
by
(
cs_prems
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
qed
show "β!f'. f' : r β¦βπβ r' β§ u' = umap_of π c r ?u r'β¦ArrValβ¦β¦f'β¦"
proof(intro ex1I conjI; (elim conjE)?)
from assms prems show
"(Οβ¦NTMapβ¦β¦r'β¦)Β―β©Cβcat_Set Ξ±ββ¦ArrValβ¦β¦u'β¦ : r β¦βπβ r'"
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_arrow_cs_intros
)
with assms(1,2) prems show "u' =
umap_of π c r ?u r'β¦ArrValβ¦β¦(Οβ¦NTMapβ¦β¦r'β¦)Β―β©Cβcat_Set Ξ±ββ¦ArrValβ¦β¦u'β¦β¦"
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_arrow_cs_intros cat_cs_intros cat_op_intros
)
fix f' assume prems':
"f' : r β¦βπβ r'"
"u' = umap_of π c r (Οβ¦NTMapβ¦β¦rβ¦β¦ArrValβ¦β¦πβ¦CIdβ¦β¦rβ¦β¦) r'β¦ArrValβ¦β¦f'β¦"
from prems'(2,1) assms(1,2) have u'_def:
"u' = πβ¦ArrMapβ¦β¦f'β¦ ββ©Aβπ
β Οβ¦NTMapβ¦β¦rβ¦β¦ArrValβ¦β¦πβ¦CIdβ¦β¦rβ¦β¦"
by
(
cs_prems
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros
)
from prems' show "f' = (Οβ¦NTMapβ¦β¦r'β¦)Β―β©Cβcat_Set Ξ±ββ¦ArrValβ¦β¦u'β¦"
unfolding u'_def Οr'_ArrVal_app[OF prems'(1)]
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_arrow_cs_intros cat_cs_intros cat_op_intros
)
qed
qed
qed
lemma (in is_functor) cf_universal_arrow_fo_if_is_iso_ntcf:
assumes "r ββ©β πβ¦Objβ¦"
and "c ββ©β π
β¦Objβ¦"
and "Ο :
Homβ©Oβ©.β©CβΞ±βπ(-,r) β¦β©Cβ©Fβ©.β©iβ©sβ©o Homβ©Oβ©.β©CβΞ±βπ
(-,c) ββ©Cβ©F op_cf π :
op_cat π β¦β¦β©CβΞ±β cat_Set Ξ±"
shows "universal_arrow_fo π c r (Οβ¦NTMapβ¦β¦rβ¦β¦ArrValβ¦β¦πβ¦CIdβ¦β¦rβ¦β¦)"
by
(
rule is_functor.cf_universal_arrow_of_if_is_iso_ntcf
[
OF is_functor_op,
unfolded cat_op_simps,
OF assms(1,2),
unfolded
HomDom.cat_op_cat_cf_Hom_snd[OF assms(1)]
HomCod.cat_op_cat_cf_Hom_snd[OF assms(2)]
ntcf_ua_fo_def[symmetric],
OF assms(3)
]
)
lemma (in is_functor) cf_universal_arrow_of_if_is_iso_ntcf_if_ge_Limit:
assumes "π΅ Ξ²"
and "Ξ± ββ©β Ξ²"
and "r ββ©β πβ¦Objβ¦"
and "c ββ©β π
β¦Objβ¦"
and "Ο :
Homβ©Oβ©.β©CβΞ²βπ(r,-) β¦β©Cβ©Fβ©.β©iβ©sβ©o Homβ©Oβ©.β©CβΞ²βπ
(c,-) ββ©Cβ©F π :
π β¦β¦β©CβΞ²β cat_Set Ξ²"
shows "universal_arrow_of π c r (Οβ¦NTMapβ¦β¦rβ¦β¦ArrValβ¦β¦πβ¦CIdβ¦β¦rβ¦β¦)"
(is βΉuniversal_arrow_of π c r ?uβΊ)
proof-
interpret Ξ²: π΅ Ξ² by (rule assms(1))
interpret cat_Set_Ξ±Ξ²: subcategory Ξ² βΉcat_Set Ξ±βΊ βΉcat_Set Ξ²βΊ
by (rule subcategory_cat_Set_cat_Set[OF assms(1,2)])
interpret Ο: is_iso_ntcf
Ξ² π βΉcat_Set Ξ²βΊ βΉHomβ©Oβ©.β©CβΞ²βπ(r,-)βΊ βΉHomβ©Oβ©.β©CβΞ²βπ
(c,-) ββ©Cβ©F πβΊ Ο
by (rule assms(5))
interpret Ξ²π: category Ξ² π
by (rule category.cat_category_if_ge_Limit)
(use assms(2) in βΉcs_concl cs_simp: cs_intro: cat_cs_introsβΊ)+
interpret Ξ²π
: category Ξ² π
by (rule category.cat_category_if_ge_Limit)
(use assms(2) in βΉcs_concl cs_simp: cs_intro: cat_cs_introsβΊ)+
interpret Ξ²π: is_functor Ξ² π π
π
by (rule cf_is_functor_if_ge_Limit)
(use assms(2) in βΉcs_concl cs_simp: cs_intro: cat_cs_introsβΊ)+
show ?thesis
proof(intro universal_arrow_ofI assms)
from assms(3,4) show u: "?u : c β¦βπ
β πβ¦ObjMapβ¦β¦rβ¦"
by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
fix r' u' assume prems: "r' ββ©β πβ¦Objβ¦" "u' : c β¦βπ
β πβ¦ObjMapβ¦β¦r'β¦"
have Οr'_ArrVal_app[symmetric, cat_cs_simps]:
"Οβ¦NTMapβ¦β¦r'β¦β¦ArrValβ¦β¦f'β¦ =
πβ¦ArrMapβ¦β¦f'β¦ ββ©Aβπ
β Οβ¦NTMapβ¦β¦rβ¦β¦ArrValβ¦β¦πβ¦CIdβ¦β¦rβ¦β¦"
if "f' : r β¦βπβ r'" for f'
proof-
have "Οβ¦NTMapβ¦β¦r'β¦ ββ©Aβcat_Set Ξ²β Homβ©Oβ©.β©CβΞ²βπ(r,-)β¦ArrMapβ¦β¦f'β¦ =
(Homβ©Oβ©.β©CβΞ²βπ
(c,-) ββ©Cβ©F π)β¦ArrMapβ¦β¦f'β¦ ββ©Aβcat_Set Ξ²β Οβ¦NTMapβ¦β¦rβ¦"
using that by (intro Ο.ntcf_Comp_commute)
then have
"Οβ¦NTMapβ¦β¦r'β¦ ββ©Aβcat_Set Ξ²β cf_hom π [πβ¦CIdβ¦β¦rβ¦, f']β©β =
cf_hom π
[π
β¦CIdβ¦β¦cβ¦, πβ¦ArrMapβ¦β¦f'β¦]β©β ββ©Aβcat_Set Ξ²β Οβ¦NTMapβ¦β¦rβ¦"
using assms(3,4) assms(1,2) that prems
by (cs_prems cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
then have
"(Οβ¦NTMapβ¦β¦r'β¦ ββ©Aβcat_Set Ξ²β
cf_hom π [πβ¦CIdβ¦β¦rβ¦, f']β©β)β¦ArrValβ¦β¦πβ¦CIdβ¦β¦rβ¦β¦ =
(cf_hom π
[π
β¦CIdβ¦β¦cβ¦, πβ¦ArrMapβ¦β¦f'β¦]β©β ββ©Aβcat_Set Ξ²β
Οβ¦NTMapβ¦β¦rβ¦)β¦ArrValβ¦β¦πβ¦CIdβ¦β¦rβ¦β¦"
by simp
from
this assms(3,4,2) u that HomDom.category_axioms HomCod.category_axioms
show ?thesis
by
(
cs_prems
cs_simp: cat_cs_simps cat_op_simps
cs_intro:
cat_cs_intros
cat_op_intros
cat_prod_cs_intros
cat_Set_Ξ±Ξ².subcat_is_arrD
)
qed
show "β!f'. f' : r β¦βπβ r' β§ u' = umap_of π c r ?u r'β¦ArrValβ¦β¦f'β¦"
proof(intro ex1I conjI; (elim conjE)?)
from assms prems HomDom.category_axioms show
"(Οβ¦NTMapβ¦β¦r'β¦)Β―β©Cβcat_Set Ξ²ββ¦ArrValβ¦β¦u'β¦ : r β¦βπβ r'"
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_arrow_cs_intros
)
with assms(3,4) prems show "u' =
umap_of π c r ?u r'β¦ArrValβ¦β¦(Οβ¦NTMapβ¦β¦r'β¦)Β―β©Cβcat_Set Ξ²ββ¦ArrValβ¦β¦u'β¦β¦"
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_arrow_cs_intros cat_cs_intros cat_op_intros
)
fix f' assume prems':
"f' : r β¦βπβ r'"
"u' = umap_of π c r (Οβ¦NTMapβ¦β¦rβ¦β¦ArrValβ¦β¦πβ¦CIdβ¦β¦rβ¦β¦) r'β¦ArrValβ¦β¦f'β¦"
from prems'(2,1) assms(3,4) have u'_def:
"u' = πβ¦ArrMapβ¦β¦f'β¦ ββ©Aβπ
β Οβ¦NTMapβ¦β¦rβ¦β¦ArrValβ¦β¦πβ¦CIdβ¦β¦rβ¦β¦"
by
(
cs_prems
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros
)
from prems' show "f' = (Οβ¦NTMapβ¦β¦r'β¦)Β―β©Cβcat_Set Ξ²ββ¦ArrValβ¦β¦u'β¦"
unfolding u'_def Οr'_ArrVal_app[OF prems'(1)]
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_arrow_cs_intros cat_cs_intros cat_op_intros
)
qed
qed
qed
lemma (in is_functor) cf_universal_arrow_fo_if_is_iso_ntcf_if_ge_Limit:
assumes "π΅ Ξ²"
and "Ξ± ββ©β Ξ²"
and "r ββ©β πβ¦Objβ¦"
and "c ββ©β π
β¦Objβ¦"
and "Ο :
Homβ©Oβ©.β©CβΞ²βπ(-,r) β¦β©Cβ©Fβ©.β©iβ©sβ©o Homβ©Oβ©.β©CβΞ²βπ
(-,c) ββ©Cβ©F op_cf π :
op_cat π β¦β¦β©CβΞ²β cat_Set Ξ²"
shows "universal_arrow_fo π c r (Οβ¦NTMapβ¦β¦rβ¦β¦ArrValβ¦β¦πβ¦CIdβ¦β¦rβ¦β¦)"
proof-
interpret Ξ²: π΅ Ξ² by (rule assms(1))
interpret Ξ²π: is_functor Ξ² π π
π
by (rule cf_is_functor_if_ge_Limit)
(use assms(2) in βΉcs_concl cs_intro: cat_cs_introsβΊ)+
show ?thesis
by
(
rule is_functor.cf_universal_arrow_of_if_is_iso_ntcf_if_ge_Limit
[
OF is_functor_op,
OF assms(1,2),
unfolded cat_op_simps,
OF assms(3,4),
unfolded
Ξ²π.HomDom.cat_op_cat_cf_Hom_snd[OF assms(3)]
Ξ²π.HomCod.cat_op_cat_cf_Hom_snd[OF assms(4)]
ntcf_ua_fo_def[symmetric],
OF assms(5)
]
)
qed
textβΉ\newpageβΊ
endTheory CZH_UCAT_Limit
sectionβΉLimitsβΊ
theory CZH_UCAT_Limit
imports
CZH_UCAT_Universal
CZH_Elementary_Categories.CZH_ECAT_Discrete
CZH_Elementary_Categories.CZH_ECAT_SS
CZH_Elementary_Categories.CZH_ECAT_Parallel
begin
subsectionβΉBackgroundβΊ
named_theorems cat_lim_cs_simps
named_theorems cat_lim_cs_intros
subsectionβΉCone and coconeβΊ
textβΉ
In the context of this work, the concept of a cone corresponds to that of a cone
to the base of a functor from a vertex, as defined in Chapter III-4 in
\cite{mac_lane_categories_2010}; the concept of a cocone corresponds to that
of a cone from the base of a functor to a vertex, as defined in Chapter III-3
in \cite{mac_lane_categories_2010}.
In this body of work, only limits and colimits of functors with tiny maps
are considered. The definitions of a cone and a cocone also reflect this.
However, this restriction may be removed in the future.
βΊ
locale is_cat_cone = is_tm_ntcf Ξ± π β βΉcf_const π β cβΊ π π for Ξ± c π β π π +
assumes cat_cone_obj[cat_lim_cs_intros]: "c ββ©β ββ¦Objβ¦"
syntax "_is_cat_cone" :: "V β V β V β V β V β V β bool"
(βΉ(_ :/ _ <β©Cβ©Fβ©.β©cβ©oβ©nβ©e _ :/ _ β¦β¦β©CΔ± _)βΊ [51, 51, 51, 51, 51] 51)
translations "π : c <β©Cβ©Fβ©.β©cβ©oβ©nβ©e π : π β¦β¦β©CβΞ±β β" β
"CONST is_cat_cone Ξ± c π β π π"
locale is_cat_cocone = is_tm_ntcf Ξ± π β π βΉcf_const π β cβΊ π for Ξ± c π β π π +
assumes cat_cocone_obj[cat_lim_cs_intros]: "c ββ©β ββ¦Objβ¦"
syntax "_is_cat_cocone" :: "V β V β V β V β V β V β bool"
(βΉ(_ :/ _ >β©Cβ©Fβ©.β©cβ©oβ©cβ©oβ©nβ©e _ :/ _ β¦β¦β©CΔ± _)βΊ [51, 51, 51, 51, 51] 51)
translations "π : π >β©Cβ©Fβ©.β©cβ©oβ©cβ©oβ©nβ©e c : π β¦β¦β©CβΞ±β β" β
"CONST is_cat_cocone Ξ± c π β π π"
textβΉRules.βΊ
lemma (in is_cat_cone) is_cat_cone_axioms'[cat_lim_cs_intros]:
assumes "Ξ±' = Ξ±" and "c' = c" and "π' = π" and "β' = β" and "π' = π"
shows "π : c' <β©Cβ©Fβ©.β©cβ©oβ©nβ©e π' : π' β¦β¦β©CβΞ±'β β'"
unfolding assms by (rule is_cat_cone_axioms)
mk_ide rf is_cat_cone_def[unfolded is_cat_cone_axioms_def]
|intro is_cat_coneI|
|dest is_cat_coneD[dest!]|
|elim is_cat_coneE[elim!]|
lemma (in is_cat_cone) is_cat_coneD'[cat_lim_cs_intros]:
assumes "c' = cf_const π β c"
shows "π : c' β¦β©Cβ©Fβ©.β©tβ©m π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
unfolding assms by (cs_concl cs_intro: cat_small_cs_intros)
lemmas [cat_lim_cs_intros] = is_cat_cone.is_cat_coneD'
lemma (in is_cat_cocone) is_cat_cocone_axioms'[cat_lim_cs_intros]:
assumes "Ξ±' = Ξ±" and "c' = c" and "π' = π" and "β' = β" and "π' = π"
shows "π : π' >β©Cβ©Fβ©.β©cβ©oβ©cβ©oβ©nβ©e c' : π' β¦β¦β©CβΞ±'β β'"
unfolding assms by (rule is_cat_cocone_axioms)
mk_ide rf is_cat_cocone_def[unfolded is_cat_cocone_axioms_def]
|intro is_cat_coconeI|
|dest is_cat_coconeD[dest!]|
|elim is_cat_coconeE[elim!]|
lemma (in is_cat_cocone) is_cat_coconeD'[cat_lim_cs_intros]:
assumes "c' = cf_const π β c"
shows "π : π β¦β©Cβ©Fβ©.β©tβ©m c' : π β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
unfolding assms by (cs_concl cs_intro: cat_small_cs_intros)
lemmas [cat_lim_cs_intros] = is_cat_cocone.is_cat_coconeD'
textβΉDuality.βΊ
lemma (in is_cat_cone) is_cat_cocone_op:
"op_ntcf π : op_cf π >β©Cβ©Fβ©.β©cβ©oβ©cβ©oβ©nβ©e c : op_cat π β¦β¦β©CβΞ±β op_cat β"
by (intro is_cat_coconeI)
(cs_concl cs_simp: cat_op_simps cs_intro: cat_lim_cs_intros cat_op_intros)+
lemma (in is_cat_cone) is_cat_cocone_op'[cat_op_intros]:
assumes "Ξ±' = Ξ±" and "π' = op_cat π" and "β' = op_cat β" and "π' = op_cf π"
shows "op_ntcf π : π' >β©Cβ©Fβ©.β©cβ©oβ©cβ©oβ©nβ©e c : π' β¦β¦β©CβΞ±'β β'"
unfolding assms by (rule is_cat_cocone_op)
lemmas [cat_op_intros] = is_cat_cone.is_cat_cocone_op'
lemma (in is_cat_cocone) is_cat_cone_op:
"op_ntcf π : c <β©Cβ©Fβ©.β©cβ©oβ©nβ©e op_cf π : op_cat π β¦β¦β©CβΞ±β op_cat β"
by (intro is_cat_coneI)
(cs_concl cs_simp: cat_op_simps cs_intro: cat_lim_cs_intros cat_op_intros)
lemma (in is_cat_cocone) is_cat_cone_op'[cat_op_intros]:
assumes "Ξ±' = Ξ±" and "π' = op_cat π" and "β' = op_cat β" and "π' = op_cf π"
shows "op_ntcf π : c <β©Cβ©Fβ©.β©cβ©oβ©nβ©e π' : π' β¦β¦β©CβΞ±'β β'"
unfolding assms by (rule is_cat_cone_op)
lemmas [cat_op_intros] = is_cat_cocone.is_cat_cone_op'
textβΉElementary properties.βΊ
lemma (in is_cat_cone) cat_cone_LArr_app_is_arr:
assumes "j ββ©β πβ¦Objβ¦"
shows "πβ¦NTMapβ¦β¦jβ¦ : c β¦βββ πβ¦ObjMapβ¦β¦jβ¦"
proof-
from assms have [simp]: "cf_const π β cβ¦ObjMapβ¦β¦jβ¦ = c"
by (cs_concl cs_simp: cat_cs_simps)
from ntcf_NTMap_is_arr[OF assms] show ?thesis by simp
qed
lemma (in is_cat_cone) cat_cone_LArr_app_is_arr'[cat_lim_cs_intros]:
assumes "j ββ©β πβ¦Objβ¦" and "πj = πβ¦ObjMapβ¦β¦jβ¦"
shows "πβ¦NTMapβ¦β¦jβ¦ : c β¦βββ πj"
using assms(1) unfolding assms(2) by (rule cat_cone_LArr_app_is_arr)
lemmas [cat_lim_cs_intros] = is_cat_cone.cat_cone_LArr_app_is_arr'
lemma (in is_cat_cocone) cat_cocone_LArr_app_is_arr:
assumes "j ββ©β πβ¦Objβ¦"
shows "πβ¦NTMapβ¦β¦jβ¦ : πβ¦ObjMapβ¦β¦jβ¦ β¦βββ c"
proof-
from assms have [simp]: "cf_const π β cβ¦ObjMapβ¦β¦jβ¦ = c"
by (cs_concl cs_simp: cat_cs_simps)
from ntcf_NTMap_is_arr[OF assms] show ?thesis by simp
qed
lemma (in is_cat_cocone) cat_cocone_LArr_app_is_arr'[cat_lim_cs_intros]:
assumes "j ββ©β πβ¦Objβ¦" and "πj = πβ¦ObjMapβ¦β¦jβ¦"
shows "πβ¦NTMapβ¦β¦jβ¦ : πj β¦βββ c"
using assms(1) unfolding assms(2) by (rule cat_cocone_LArr_app_is_arr)
lemmas [cat_lim_cs_intros] = is_cat_cocone.cat_cocone_LArr_app_is_arr'
lemma (in is_cat_cone) cat_cone_Comp_commute[cat_lim_cs_simps]:
assumes "f : a β¦βπβ b"
shows "πβ¦ArrMapβ¦β¦fβ¦ ββ©Aβββ πβ¦NTMapβ¦β¦aβ¦ = πβ¦NTMapβ¦β¦bβ¦"
using ntcf_Comp_commute[symmetric, OF assms] assms
by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
lemmas [cat_lim_cs_simps] = is_cat_cone.cat_cone_Comp_commute
lemma (in is_cat_cocone) cat_cocone_Comp_commute[cat_lim_cs_simps]:
assumes "f : a β¦βπβ b"
shows "πβ¦NTMapβ¦β¦bβ¦ ββ©Aβββ πβ¦ArrMapβ¦β¦fβ¦ = πβ¦NTMapβ¦β¦aβ¦"
using ntcf_Comp_commute[OF assms] assms
by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
lemmas [cat_lim_cs_simps] = is_cat_cocone.cat_cocone_Comp_commute
textβΉUtilities/helper lemmas.βΊ
lemma (in is_cat_cone) helper_cat_cone_ntcf_vcomp_Comp:
assumes "π' : c' <β©Cβ©Fβ©.β©cβ©oβ©nβ©e π : π β¦β¦β©CβΞ±β β"
and "f' : c' β¦βββ c"
and "π' = π ββ©Nβ©Tβ©Cβ©F ntcf_const π β f'"
and "j ββ©β πβ¦Objβ¦"
shows "π'β¦NTMapβ¦β¦jβ¦ = πβ¦NTMapβ¦β¦jβ¦ ββ©Aβββ f'"
proof-
from assms(3) have "π'β¦NTMapβ¦β¦jβ¦ = (π ββ©Nβ©Tβ©Cβ©F ntcf_const π β f')β¦NTMapβ¦β¦jβ¦"
by simp
from this assms(1,2,4) show "π'β¦NTMapβ¦β¦jβ¦ = πβ¦NTMapβ¦β¦jβ¦ ββ©Aβββ f'"
by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
lemma (in is_cat_cone) helper_cat_cone_Comp_ntcf_vcomp:
assumes "π' : c' <β©Cβ©Fβ©.β©cβ©oβ©nβ©e π : π β¦β¦β©CβΞ±β β"
and "f' : c' β¦βββ c"
and "βj. j ββ©β πβ¦Objβ¦ βΉ π'β¦NTMapβ¦β¦jβ¦ = πβ¦NTMapβ¦β¦jβ¦ ββ©Aβββ f'"
shows "π' = π ββ©Nβ©Tβ©Cβ©F ntcf_const π β f'"
proof-
interpret π': is_cat_cone Ξ± c' π β π π' by (rule assms(1))
show ?thesis
proof(rule ntcf_eqI[OF π'.is_ntcf_axioms])
from assms(2) show
"π ββ©Nβ©Tβ©Cβ©F ntcf_const π β f' : cf_const π β c' β¦β©Cβ©F π : π β¦β¦β©CβΞ±β β"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "π'β¦NTMapβ¦ = (π ββ©Nβ©Tβ©Cβ©F ntcf_const π β f')β¦NTMapβ¦"
proof(rule vsv_eqI, unfold cat_cs_simps)
show "vsv ((π ββ©Nβ©Tβ©Cβ©F ntcf_const π β f')β¦NTMapβ¦)"
by (cs_concl cs_intro: cat_cs_intros)
from assms show "πβ¦Objβ¦ = πβ©β ((π ββ©Nβ©Tβ©Cβ©F ntcf_const π β f')β¦NTMapβ¦)"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
fix j assume prems': "j ββ©β πβ¦Objβ¦"
with assms(1,2) show "π'β¦NTMapβ¦β¦jβ¦ = (π ββ©Nβ©Tβ©Cβ©F ntcf_const π β f')β¦NTMapβ¦β¦jβ¦"
by (cs_concl cs_simp: cat_cs_simps assms(3) cs_intro: cat_cs_intros)
qed auto
qed simp_all
qed
lemma (in is_cat_cone) helper_cat_cone_Comp_ntcf_vcomp_iff:
assumes "π' : c' <β©Cβ©Fβ©.β©cβ©oβ©nβ©e π : π β¦β¦β©CβΞ±β β"
shows "f' : c' β¦βββ c β§ π' = π ββ©Nβ©Tβ©Cβ©F ntcf_const π β f' β·
f' : c' β¦βββ c β§ (βjββ©βπβ¦Objβ¦. π'β¦NTMapβ¦β¦jβ¦ = πβ¦NTMapβ¦β¦jβ¦ ββ©Aβββ f')"
using
helper_cat_cone_ntcf_vcomp_Comp[OF assms]
helper_cat_cone_Comp_ntcf_vcomp[OF assms]
by (intro iffI; elim conjE; intro conjI) metis+
lemma (in is_cat_cocone) helper_cat_cocone_ntcf_vcomp_Comp:
assumes "π' : π >β©Cβ©Fβ©.β©cβ©oβ©cβ©oβ©nβ©e c' : π β¦β¦β©CβΞ±β β"
and "f' : c β¦βββ c'"
and "π' = ntcf_const π β f' ββ©Nβ©Tβ©Cβ©F π"
and "j ββ©β πβ¦Objβ¦"
shows "π'β¦NTMapβ¦β¦jβ¦ = f' ββ©Aβββ πβ¦NTMapβ¦β¦jβ¦"
proof-
interpret π': is_cat_cocone Ξ± c' π β π π' by (rule assms(1))
from assms(3) have "op_ntcf π' = op_ntcf (ntcf_const π β f' ββ©Nβ©Tβ©Cβ©F π)" by simp
from this assms(2) have op_π':
"op_ntcf π' = op_ntcf π ββ©Nβ©Tβ©Cβ©F ntcf_const (op_cat π) (op_cat β) f'"
by (cs_prems cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_op_intros)
have "π'β¦NTMapβ¦β¦jβ¦ = πβ¦NTMapβ¦β¦jβ¦ ββ©Aβop_cat ββ f'"
by
(
rule is_cat_cone.helper_cat_cone_ntcf_vcomp_Comp[
OF is_cat_cone_op π'.is_cat_cone_op,
unfolded cat_op_simps,
OF assms(2) op_π' assms(4)
]
)
from this assms(2,4) show "π'β¦NTMapβ¦β¦jβ¦ = f' ββ©Aβββ πβ¦NTMapβ¦β¦jβ¦"
by (cs_prems cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
qed
lemma (in is_cat_cocone) helper_cat_cocone_Comp_ntcf_vcomp:
assumes "π' : π >β©Cβ©Fβ©.β©cβ©oβ©cβ©oβ©nβ©e c' : π β¦β¦β©CβΞ±β β"
and "f' : c β¦βββ c'"
and "βj. j ββ©β πβ¦Objβ¦ βΉ π'β¦NTMapβ¦β¦jβ¦ = f' ββ©Aβββ πβ¦NTMapβ¦β¦jβ¦"
shows "π' = ntcf_const π β f' ββ©Nβ©Tβ©Cβ©F π"
proof-
interpret π': is_cat_cocone Ξ± c' π β π π' by (rule assms(1))
from assms(2) have π'j: "π'β¦NTMapβ¦β¦jβ¦ = πβ¦NTMapβ¦β¦jβ¦ ββ©Aβop_cat ββ f'"
if "j ββ©β πβ¦Objβ¦" for j
using that
unfolding assms(3)[OF that]
by (cs_concl cs_simp: cat_op_simps cat_cs_simps cs_intro: cat_cs_intros)
have op_π':
"op_ntcf π' = op_ntcf π ββ©Nβ©Tβ©Cβ©F ntcf_const (op_cat π) (op_cat β) f'"
by
(
rule is_cat_cone.helper_cat_cone_Comp_ntcf_vcomp[
OF is_cat_cone_op π'.is_cat_cone_op,
unfolded cat_op_simps,
OF assms(2) π'j,
simplified
]
)
from assms(2) show "π' = (ntcf_const π β f' ββ©Nβ©Tβ©Cβ©F π)"
by
(
cs_concl
cs_simp:
cat_op_simps op_π' eq_op_ntcf_iff[symmetric, OF π'.is_ntcf_axioms]
cs_intro: cat_cs_intros
)
qed
lemma (in is_cat_cocone) helper_cat_cocone_Comp_ntcf_vcomp_iff:
assumes "π' : π >β©Cβ©Fβ©.β©cβ©oβ©cβ©oβ©nβ©e c' : π β¦β¦β©CβΞ±β β"
shows "f' : c β¦βββ c' β§ π' = ntcf_const π β f' ββ©Nβ©Tβ©Cβ©F π β·
f' : c β¦βββ c' β§ (βjββ©βπβ¦Objβ¦. π'β¦NTMapβ¦β¦jβ¦ = f' ββ©Aβββ πβ¦NTMapβ¦β¦jβ¦)"
using
helper_cat_cocone_ntcf_vcomp_Comp[OF assms]
helper_cat_cocone_Comp_ntcf_vcomp[OF assms]
by (intro iffI; elim conjE; intro conjI) metis+
subsectionβΉLimit and colimitβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉ
The concept of a limit is introduced in Chapter III-4 in
\cite{mac_lane_categories_2010}; the concept of a colimit is introduced in
Chapter III-3 in \cite{mac_lane_categories_2010}.
βΊ
locale is_cat_limit = is_cat_cone Ξ± r π β π u for Ξ± π β π r u +
assumes cat_lim_ua_fo:
"universal_arrow_fo (Ξβ©C Ξ± π β) (cf_map π) r (ntcf_arrow u)"
syntax "_is_cat_limit" :: "V β V β V β V β V β V β bool"
(βΉ(_ :/ _ <β©Cβ©Fβ©.β©lβ©iβ©m _ :/ _ β¦β¦β©CΔ± _)βΊ [51, 51, 51, 51, 51] 51)
translations "u : r <β©Cβ©Fβ©.β©lβ©iβ©m π : π β¦β¦β©CβΞ±β β" β
"CONST is_cat_limit Ξ± π β π r u"
locale is_cat_colimit = is_cat_cocone Ξ± r π β π u for Ξ± π β π r u +
assumes cat_colim_ua_fo: "universal_arrow_fo
(Ξβ©C Ξ± (op_cat π) (op_cat β)) (cf_map π) r (ntcf_arrow (op_ntcf u))"
syntax "_is_cat_colimit" :: "V β V β V β V β V β V β bool"
(βΉ(_ :/ _ >β©Cβ©Fβ©.β©cβ©oβ©lβ©iβ©m _ :/ _ β¦β¦β©CΔ± _)βΊ [51, 51, 51, 51, 51] 51)
translations "u : π >β©Cβ©Fβ©.β©cβ©oβ©lβ©iβ©m r : π β¦β¦β©CβΞ±β β" β
"CONST is_cat_colimit Ξ± π β π r u"
textβΉRules.βΊ
lemma (in is_cat_limit) is_cat_limit_axioms'[cat_lim_cs_intros]:
assumes "Ξ±' = Ξ±" and "r' = r" and "π' = π" and "β' = β" and "π' = π"
shows "u : r' <β©Cβ©Fβ©.β©lβ©iβ©m π' : π' β¦β¦β©CβΞ±'β β'"
unfolding assms by (rule is_cat_limit_axioms)
mk_ide rf is_cat_limit_def[unfolded is_cat_limit_axioms_def]
|intro is_cat_limitI|
|dest is_cat_limitD[dest]|
|elim is_cat_limitE[elim]|
lemmas [cat_lim_cs_intros] = is_cat_limitD(1)
lemma (in is_cat_colimit) is_cat_colimit_axioms'[cat_lim_cs_intros]:
assumes "Ξ±' = Ξ±" and "r' = r" and "π' = π" and "β' = β" and "π' = π"
shows "u : π' >β©Cβ©Fβ©.β©cβ©oβ©lβ©iβ©m r' : π' β¦β¦β©CβΞ±'β β'"
unfolding assms by (rule is_cat_colimit_axioms)
mk_ide rf is_cat_colimit_def[unfolded is_cat_colimit_axioms_def]
|intro is_cat_colimitI|
|dest is_cat_colimitD[dest]|
|elim is_cat_colimitE[elim]|
lemmas [cat_lim_cs_intros] = is_cat_colimitD(1)
textβΉDualityβΊ
lemma (in is_cat_limit) is_cat_colimit_op:
"op_ntcf u : op_cf π >β©Cβ©Fβ©.β©cβ©oβ©lβ©iβ©m r : op_cat π β¦β¦β©CβΞ±β op_cat β"
using cat_lim_ua_fo
by (intro is_cat_colimitI)
(cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_op_intros)
lemma (in is_cat_limit) is_cat_colimit_op'[cat_op_intros]:
assumes "π' = op_cf π" and "π' = op_cat π" and "β' = op_cat β"
shows "op_ntcf u : π' >β©Cβ©Fβ©.β©cβ©oβ©lβ©iβ©m r : π' β¦β¦β©CβΞ±β β'"
unfolding assms by (rule is_cat_colimit_op)
lemmas [cat_op_intros] = is_cat_limit.is_cat_colimit_op'
lemma (in is_cat_colimit) is_cat_limit_op:
"op_ntcf u : r <β©Cβ©Fβ©.β©lβ©iβ©m op_cf π : op_cat π β¦β¦β©CβΞ±β op_cat β"
using cat_colim_ua_fo
by (intro is_cat_limitI)
(cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_op_intros)
lemma (in is_cat_colimit) is_cat_colimit_op'[cat_op_intros]:
assumes "π' = op_cf π" and "π' = op_cat π" and "β' = op_cat β"
shows "op_ntcf u : r <β©Cβ©Fβ©.β©lβ©iβ©m π' : π' β¦β¦β©CβΞ±β β'"
unfolding assms by (rule is_cat_limit_op)
lemmas [cat_op_intros] = is_cat_colimit.is_cat_colimit_op'
textβΉElementary properties of limits and colimits.βΊ
sublocale is_cat_limit β Ξ: is_functor Ξ± β βΉcat_Funct Ξ± π ββΊ βΉΞβ©C Ξ± π ββΊ
by (cs_concl cs_intro: cat_cs_intros cat_small_cs_intros)
sublocale is_cat_colimit β Ξ: is_functor
Ξ± βΉop_cat ββΊ βΉcat_Funct Ξ± (op_cat π) (op_cat β)βΊ βΉΞβ©C Ξ± (op_cat π) (op_cat β)βΊ
by (cs_concl cs_intro: cat_small_cs_intros cat_cs_intros cat_op_intros)
subsubsectionβΉUniversal propertyβΊ
lemma is_cat_limitI':
assumes "u : r <β©Cβ©Fβ©.β©cβ©oβ©nβ©e π : π β¦β¦β©CβΞ±β β"
and "βu' r'. β¦ u' : r' <β©Cβ©Fβ©.β©cβ©oβ©nβ©e π : π β¦β¦β©CβΞ±β β β§ βΉ
β!f'. f' : r' β¦βββ r β§ u' = u ββ©Nβ©Tβ©Cβ©F ntcf_const π β f'"
shows "u : r <β©Cβ©Fβ©.β©lβ©iβ©m π : π β¦β¦β©CβΞ±β β"
proof(intro is_cat_limitI is_functor.universal_arrow_foI)
interpret u: is_cat_cone Ξ± r π β π u by (rule assms(1))
show "r ββ©β ββ¦Objβ¦" by (cs_concl cs_intro: cat_lim_cs_intros)
show "Ξβ©C Ξ± π β : β β¦β¦β©CβΞ±β cat_Funct Ξ± π β"
by (cs_concl cs_intro: cat_cs_intros cat_small_cs_intros)
show "ntcf_arrow u : Ξβ©C Ξ± π ββ¦ObjMapβ¦β¦rβ¦ β¦βcat_Funct Ξ± π ββ cf_map π"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_lim_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
)
fix r' u' assume prems:
"r' ββ©β ββ¦Objβ¦" "u' : Ξβ©C Ξ± π ββ¦ObjMapβ¦β¦r'β¦ β¦βcat_Funct Ξ± π ββ cf_map π"
note u' = cat_Funct_is_arrD[OF prems(2)]
from u'(1) prems(1) have u'_is_tm_ntcf:
"ntcf_of_ntcf_arrow π β u' : cf_const π β r' β¦β©Cβ©Fβ©.β©tβ©m π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
by
(
cs_prems
cs_simp: cat_cs_simps cat_small_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_cs_intros
)
from this prems(1) have u'_is_cat_cone:
"ntcf_of_ntcf_arrow π β u' : r' <β©Cβ©Fβ©.β©cβ©oβ©nβ©e π : π β¦β¦β©CβΞ±β β"
by (intro is_cat_coneI)
interpret u': is_cat_cone Ξ± r' π β π βΉntcf_of_ntcf_arrow π β u'βΊ
by (rule u'_is_cat_cone)
from assms(2)[OF u'_is_cat_cone] obtain f' where f': "f' : r' β¦βββ r"
and u'_def: "ntcf_of_ntcf_arrow π β u' = u ββ©Nβ©Tβ©Cβ©F ntcf_const π β f'"
and unique: "βf''.
β¦
f'' : r' β¦βββ r;
ntcf_of_ntcf_arrow π β u' = u ββ©Nβ©Tβ©Cβ©F ntcf_const π β f''
β§ βΉ f'' = f'"
by (meson prems(1))
from u'_def have u'_NTMap_app:
"ntcf_of_ntcf_arrow π β u'β¦NTMapβ¦β¦jβ¦ = (u ββ©Nβ©Tβ©Cβ©F ntcf_const π β f')β¦NTMapβ¦β¦jβ¦"
if "j ββ©β πβ¦Objβ¦" for j
by simp
have u'_NTMap_app: "u'β¦NTMapβ¦β¦jβ¦ = uβ¦NTMapβ¦β¦jβ¦ ββ©Aβββ f'"
if "j ββ©β πβ¦Objβ¦" for j
using u'_NTMap_app[OF that] that f'
by (cs_prems cs_simp: cat_cs_simps cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
show "β!f'.
f' : r' β¦βββ r β§
u' = umap_fo (Ξβ©C Ξ± π β) (cf_map π) r (ntcf_arrow u) r'β¦ArrValβ¦β¦f'β¦"
proof(intro ex1I conjI; (elim conjE)?)
show "f' : r' β¦βββ r" by (rule f')
have u'_def'[symmetric, cat_cs_simps]:
"ntcf_of_ntcf_arrow π β u' = u ββ©Nβ©Tβ©Cβ©F ntcf_const π β f'"
proof(rule ntcf_eqI)
from u'_is_tm_ntcf show
"ntcf_of_ntcf_arrow π β u' : cf_const π β r' β¦β©Cβ©F π : π β¦β¦β©CβΞ±β β"
by (cs_concl cs_intro: cat_small_cs_intros)
from f' show
"u ββ©Nβ©Tβ©Cβ©F ntcf_const π β f' : cf_const π β r' β¦β©Cβ©F π : π β¦β¦β©CβΞ±β β"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show
"ntcf_of_ntcf_arrow π β u'β¦NTMapβ¦ = (u ββ©Nβ©Tβ©Cβ©F ntcf_const π β f')β¦NTMapβ¦"
proof(rule vsv_eqI)
from f' show "πβ©β (ntcf_of_ntcf_arrow π β u'β¦NTMapβ¦) =
πβ©β ((u ββ©Nβ©Tβ©Cβ©F ntcf_const π β f')β¦NTMapβ¦)"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "ntcf_of_ntcf_arrow π β u'β¦NTMapβ¦β¦aβ¦ =
(u ββ©Nβ©Tβ©Cβ©F ntcf_const π β f')β¦NTMapβ¦β¦aβ¦"
if "a ββ©β πβ©β (ntcf_of_ntcf_arrow π β u'β¦NTMapβ¦)" for a
proof-
from that have "a ββ©β πβ¦Objβ¦" by (cs_prems cs_simp: cat_cs_simps)
with f' show
"ntcf_of_ntcf_arrow π β u'β¦NTMapβ¦β¦aβ¦ =
(u ββ©Nβ©Tβ©Cβ©F ntcf_const π β f')β¦NTMapβ¦β¦aβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps u'_NTMap_app
cs_intro: cat_cs_intros
)
qed
qed (auto intro: cat_cs_intros)
qed simp_all
from f' u'(1) show
"u' = umap_fo (Ξβ©C Ξ± π β) (cf_map π) r (ntcf_arrow u) r'β¦ArrValβ¦β¦f'β¦"
by (subst u'(2))
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_FUNCT_cs_intros cat_small_cs_intros
)
fix f'' assume prems':
"f'' : r' β¦βββ r"
"u' = umap_fo (Ξβ©C Ξ± π β) (cf_map π) r (ntcf_arrow u) r'β¦ArrValβ¦β¦f''β¦"
from prems'(2,1) u'(1) have
"ntcf_of_ntcf_arrow π β u' = u ββ©Nβ©Tβ©Cβ©F ntcf_const π β f''"
by (subst (asm) u'(2))
(
cs_prems
cs_simp: cat_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
from unique[OF prems'(1) this] show "f'' = f'" .
qed
qed (intro assms)+
lemma (in is_cat_limit) cat_lim_unique_cone:
assumes "u' : r' <β©Cβ©Fβ©.β©cβ©oβ©nβ©e π : π β¦β¦β©CβΞ±β β"
shows "β!f'. f' : r' β¦βββ r β§ u' = u ββ©Nβ©Tβ©Cβ©F ntcf_const π β f'"
proof-
interpret u': is_cat_cone Ξ± r' π β π u' by (rule assms(1))
have "ntcf_arrow u' : Ξβ©C Ξ± π ββ¦ObjMapβ¦β¦r'β¦ β¦βcat_Funct Ξ± π ββ cf_map π"
by
(
cs_concl
cs_intro: cat_lim_cs_intros cat_FUNCT_cs_intros cs_simp: cat_cs_simps
)
from Ξ.universal_arrow_foD(3)[OF cat_lim_ua_fo u'.cat_cone_obj this] obtain f'
where f': "f' : r' β¦βββ r"
and u': "ntcf_arrow u' =
umap_fo (Ξβ©C Ξ± π β) (cf_map π) r (ntcf_arrow u) r'β¦ArrValβ¦β¦f'β¦"
and unique:
"β¦
f'' : r' β¦βββ r;
ntcf_arrow u' =
umap_fo (Ξβ©C Ξ± π β) (cf_map π) r (ntcf_arrow u) r'β¦ArrValβ¦β¦f''β¦
β§ βΉ f'' = f'"
for f''
by metis
show "β!f'. f' : r' β¦βββ r β§ u' = u ββ©Nβ©Tβ©Cβ©F ntcf_const π β f'"
proof(intro ex1I conjI; (elim conjE)?)
show "f' : r' β¦βββ r" by (rule f')
with u' show "u' = u ββ©Nβ©Tβ©Cβ©F ntcf_const π β f'"
by
(
cs_prems
cs_simp: cat_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_FUNCT_cs_intros cat_small_cs_intros
)
fix f'' assume prems: "f'' : r' β¦βββ r" "u' = u ββ©Nβ©Tβ©Cβ©F ntcf_const π β f''"
from prems(1) have "ntcf_arrow u' =
umap_fo (Ξβ©C Ξ± π β) (cf_map π) r (ntcf_arrow u) r'β¦ArrValβ¦β¦f''β¦"
by
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps prems(2)[symmetric]
cs_intro: cat_cs_intros cat_FUNCT_cs_intros cat_small_cs_intros
)
from prems(1) this show "f'' = f'" by (intro unique)
qed
qed
lemma (in is_cat_limit) cat_lim_unique_cone':
assumes "u' : r' <β©Cβ©Fβ©.β©cβ©oβ©nβ©e π : π β¦β¦β©CβΞ±β β"
shows
"β!f'. f' : r' β¦βββ r β§ (βjββ©βπβ¦Objβ¦. u'β¦NTMapβ¦β¦jβ¦ = uβ¦NTMapβ¦β¦jβ¦ ββ©Aβββ f')"
by (fold helper_cat_cone_Comp_ntcf_vcomp_iff[OF assms(1)])
(intro cat_lim_unique_cone assms)
lemma (in is_cat_limit) cat_lim_unique:
assumes "u' : r' <β©Cβ©Fβ©.β©lβ©iβ©m π : π β¦β¦β©CβΞ±β β"
shows "β!f'. f' : r' β¦βββ r β§ u' = u ββ©Nβ©Tβ©Cβ©F ntcf_const π β f'"
by (intro cat_lim_unique_cone[OF is_cat_limitD(1)[OF assms]])
lemma (in is_cat_limit) cat_lim_unique':
assumes "u' : r' <β©Cβ©Fβ©.β©lβ©iβ©m π : π β¦β¦β©CβΞ±β β"
shows
"β!f'. f' : r' β¦βββ r β§ (βjββ©βπβ¦Objβ¦. u'β¦NTMapβ¦β¦jβ¦ = uβ¦NTMapβ¦β¦jβ¦ ββ©Aβββ f')"
by (intro cat_lim_unique_cone'[OF is_cat_limitD(1)[OF assms]])
lemma (in is_cat_colimit) cat_colim_unique_cocone:
assumes "u' : π >β©Cβ©Fβ©.β©cβ©oβ©cβ©oβ©nβ©e r' : π β¦β¦β©CβΞ±β β"
shows "β!f'. f' : r β¦βββ r' β§ u' = ntcf_const π β f' ββ©Nβ©Tβ©Cβ©F u"
proof-
interpret u': is_cat_cocone Ξ± r' π β π u' by (rule assms(1))
from u'.cat_cocone_obj have op_r': "r' ββ©β op_cat ββ¦Objβ¦"
unfolding cat_op_simps by simp
from
is_cat_limit.cat_lim_unique_cone[
OF is_cat_limit_op u'.is_cat_cone_op, folded op_ntcf_ntcf_const
]
obtain f' where f': "f' : r' β¦βop_cat ββ r"
and [cat_cs_simps]:
"op_ntcf u' = op_ntcf u ββ©Nβ©Tβ©Cβ©F op_ntcf (ntcf_const π β f')"
and unique:
"β¦
f'' : r' β¦βop_cat ββ r;
op_ntcf u' = op_ntcf u ββ©Nβ©Tβ©Cβ©F op_ntcf (ntcf_const π β f'')
β§ βΉ f'' = f'"
for f''
by metis
show ?thesis
proof(intro ex1I conjI; (elim conjE)?)
from f' show f': "f' : r β¦βββ r'" unfolding cat_op_simps by simp
show "u' = ntcf_const π β f' ββ©Nβ©Tβ©Cβ©F u"
by (rule eq_op_ntcf_iff[THEN iffD1], insert f')
(cs_concl cs_intro: cat_cs_intros cs_simp: cat_cs_simps cat_op_simps)+
fix f'' assume prems: "f'' : r β¦βββ r'" "u' = ntcf_const π β f'' ββ©Nβ©Tβ©Cβ©F u"
from prems(1) have "f'' : r' β¦βop_cat ββ r" unfolding cat_op_simps by simp
moreover from prems(1) have
"op_ntcf u' = op_ntcf u ββ©Nβ©Tβ©Cβ©F op_ntcf (ntcf_const π β f'')"
unfolding prems(2)
by (cs_concl cs_intro: cat_cs_intros cs_simp: cat_cs_simps cat_op_simps)
ultimately show "f'' = f'" by (rule unique)
qed
qed
lemma (in is_cat_colimit) cat_colim_unique_cocone':
assumes "u' : π >β©Cβ©Fβ©.β©cβ©oβ©cβ©oβ©nβ©e r' : π β¦β¦β©CβΞ±β β"
shows
"β!f'. f' : r β¦βββ r' β§ (βjββ©βπβ¦Objβ¦. u'β¦NTMapβ¦β¦jβ¦ = f' ββ©Aβββ uβ¦NTMapβ¦β¦jβ¦)"
by (fold helper_cat_cocone_Comp_ntcf_vcomp_iff[OF assms(1)])
(intro cat_colim_unique_cocone assms)
lemma (in is_cat_colimit) cat_colim_unique:
assumes "u' : π >β©Cβ©Fβ©.β©cβ©oβ©lβ©iβ©m r' : π β¦β¦β©CβΞ±β β"
shows "β!f'. f' : r β¦βββ r' β§ u' = ntcf_const π β f' ββ©Nβ©Tβ©Cβ©F u"
by (intro cat_colim_unique_cocone[OF is_cat_colimitD(1)[OF assms]])
lemma (in is_cat_colimit) cat_colim_unique':
assumes "u' : π >β©Cβ©Fβ©.β©cβ©oβ©lβ©iβ©m r' : π β¦β¦β©CβΞ±β β"
shows
"β!f'. f' : r β¦βββ r' β§ (βjββ©βπβ¦Objβ¦. u'β¦NTMapβ¦β¦jβ¦ = f' ββ©Aβββ uβ¦NTMapβ¦β¦jβ¦)"
proof-
interpret u': is_cat_colimit Ξ± π β π r' u' by (rule assms(1))
show ?thesis
by (fold helper_cat_cocone_Comp_ntcf_vcomp_iff[OF u'.is_cat_cocone_axioms])
(intro cat_colim_unique assms)
qed
lemma cat_lim_ex_is_arr_isomorphism:
assumes "u : r <β©Cβ©Fβ©.β©lβ©iβ©m π : π β¦β¦β©CβΞ±β β"
and "u' : r' <β©Cβ©Fβ©.β©lβ©iβ©m π : π β¦β¦β©CβΞ±β β"
obtains f where "f : r' β¦β©iβ©sβ©oβββ r" and "u' = u ββ©Nβ©Tβ©Cβ©F ntcf_const π β f"
proof-
interpret u: is_cat_limit Ξ± π β π r u by (rule assms(1))
interpret u': is_cat_limit Ξ± π β π r' u' by (rule assms(2))
obtain f where f: "f : r' β¦β©iβ©sβ©oβββ r"
and u': "ntcf_arrow u' =
umap_fo (Ξβ©C Ξ± π β) (cf_map π) r (ntcf_arrow u) r'β¦ArrValβ¦β¦fβ¦"
by
(
elim u.Ξ.cf_universal_arrow_fo_ex_is_arr_isomorphism[
OF u.cat_lim_ua_fo u'.cat_lim_ua_fo
]
)
from f have "f : r' β¦βββ r" by auto
from u' this have "u' = u ββ©Nβ©Tβ©Cβ©F ntcf_const π β f"
by
(
cs_prems
cs_simp: cat_cs_simps cat_FUNCT_cs_simps cat_small_cs_simps
cs_intro: cat_cs_intros cat_FUNCT_cs_intros cat_small_cs_intros
)
with f that show ?thesis by simp
qed
lemma cat_lim_ex_is_arr_isomorphism':
assumes "u : r <β©Cβ©Fβ©.β©lβ©iβ©m π : π β¦β¦β©CβΞ±β β"
and "u' : r' <β©Cβ©Fβ©.β©lβ©iβ©m π : π β¦β¦β©CβΞ±β β"
obtains f where "f : r' β¦β©iβ©sβ©oβββ r"
and "βj. j ββ©β πβ¦Objβ¦ βΉ u'β¦NTMapβ¦β¦jβ¦ = uβ¦NTMapβ¦β¦jβ¦ ββ©Aβββ f"
proof-
interpret u: is_cat_limit Ξ± π β π r u by (rule assms(1))
interpret u': is_cat_limit Ξ± π β π r' u' by (rule assms(2))
from assms obtain f
where iso_f: "f : r' β¦β©iβ©sβ©oβββ r" and u'_def: "u' = u ββ©Nβ©Tβ©Cβ©F ntcf_const π β f"
by (rule cat_lim_ex_is_arr_isomorphism)
then have f: "f : r' β¦βββ r" by auto
then have "u'β¦NTMapβ¦β¦jβ¦ = uβ¦NTMapβ¦β¦jβ¦ ββ©Aβββ f" if "j ββ©β πβ¦Objβ¦" for j
by
(
intro u.helper_cat_cone_ntcf_vcomp_Comp[
OF u'.is_cat_cone_axioms f u'_def that
]
)
with iso_f that show ?thesis by simp
qed
lemma cat_colim_ex_is_arr_isomorphism:
assumes "u : π >β©Cβ©Fβ©.β©cβ©oβ©lβ©iβ©m r : π β¦β¦β©CβΞ±β β"
and "u' : π >β©Cβ©Fβ©.β©cβ©oβ©lβ©iβ©m r' : π β¦β¦β©CβΞ±β β"
obtains f where "f : r β¦β©iβ©sβ©oβββ r'" and "u' = ntcf_const π β f ββ©Nβ©Tβ©Cβ©F u"
proof-
interpret u: is_cat_colimit Ξ± π β π r u by (rule assms(1))
interpret u': is_cat_colimit Ξ± π β π r' u' by (rule assms(2))
obtain f where f: "f : r' β¦β©iβ©sβ©oβop_cat ββ r"
and [cat_cs_simps]:
"op_ntcf u' = op_ntcf u ββ©Nβ©Tβ©Cβ©F ntcf_const (op_cat π) (op_cat β) f"
by
(
elim cat_lim_ex_is_arr_isomorphism[
OF u.is_cat_limit_op u'.is_cat_limit_op
]
)
from f have iso_f: "f : r β¦β©iβ©sβ©oβββ r'" unfolding cat_op_simps by simp
then have f: "f : r β¦βββ r'" by auto
have "u' = ntcf_const π β f ββ©Nβ©Tβ©Cβ©F u"
by (rule eq_op_ntcf_iff[THEN iffD1], insert f)
(cs_concl cs_intro: cat_cs_intros cs_simp: cat_cs_simps cat_op_simps)+
from iso_f this that show ?thesis by simp
qed
lemma cat_colim_ex_is_arr_isomorphism':
assumes "u : π >β©Cβ©Fβ©.β©cβ©oβ©lβ©iβ©m r : π β¦β¦β©CβΞ±β β"
and "u' : π >β©Cβ©Fβ©.β©cβ©oβ©lβ©iβ©m r' : π β¦β¦β©CβΞ±β β"
obtains f where "f : r β¦β©iβ©sβ©oβββ r'"
and "βj. j ββ©β πβ¦Objβ¦ βΉ u'β¦NTMapβ¦β¦jβ¦ = f ββ©Aβββ uβ¦NTMapβ¦β¦jβ¦"
proof-
interpret u: is_cat_colimit Ξ± π β π r u by (rule assms(1))
interpret u': is_cat_colimit Ξ± π β π r' u' by (rule assms(2))
from assms obtain f
where iso_f: "f : r β¦β©iβ©sβ©oβββ r'" and u'_def: "u' = ntcf_const π β f ββ©Nβ©Tβ©Cβ©F u"
by (rule cat_colim_ex_is_arr_isomorphism)
then have f: "f : r β¦βββ r'" by auto
then have "u'β¦NTMapβ¦β¦jβ¦ = f ββ©Aβββ uβ¦NTMapβ¦β¦jβ¦" if "j ββ©β πβ¦Objβ¦" for j
by
(
intro u.helper_cat_cocone_ntcf_vcomp_Comp[
OF u'.is_cat_cocone_axioms f u'_def that
]
)
with iso_f that show ?thesis by simp
qed
subsectionβΉFinite limit and finite colimitβΊ
locale is_cat_finite_limit = is_cat_limit Ξ± π β π r u + finite_category Ξ± π
for Ξ± π β π r u
syntax "_is_cat_finite_limit" :: "V β V β V β V β V β V β bool"
(βΉ(_ :/ _ <β©Cβ©Fβ©.β©lβ©iβ©mβ©.β©fβ©iβ©n _ :/ _ β¦β¦β©CΔ± _)βΊ [51, 51, 51, 51, 51] 51)
translations "u : r <β©Cβ©Fβ©.β©lβ©iβ©mβ©.β©fβ©iβ©n π : π β¦β¦β©CβΞ±β β" β
"CONST is_cat_finite_limit Ξ± π β π r u"
locale is_cat_finite_colimit = is_cat_colimit Ξ± π β π r u + finite_category Ξ± π
for Ξ± π β π r u
syntax "_is_cat_finite_colimit" :: "V β V β V β V β V β V β bool"
(βΉ(_ :/ _ >β©Cβ©Fβ©.β©cβ©oβ©lβ©iβ©mβ©.β©fβ©iβ©n _ :/ _ β¦β¦β©CΔ± _)βΊ [51, 51, 51, 51, 51] 51)
translations "u : π >β©Cβ©Fβ©.β©cβ©oβ©lβ©iβ©mβ©.β©fβ©iβ©n r : π β¦β¦β©CβΞ±β β" β
"CONST is_cat_finite_colimit Ξ± π β π r u"
textβΉRules.βΊ
lemma (in is_cat_finite_limit) is_cat_finite_limit_axioms'[cat_lim_cs_intros]:
assumes "Ξ±' = Ξ±" and "r' = r" and "π' = π" and "β' = β" and "π' = π"
shows "u : r' <β©Cβ©Fβ©.β©lβ©iβ©mβ©.β©fβ©iβ©n π' : π' β¦β¦β©CβΞ±'β β'"
unfolding assms by (rule is_cat_finite_limit_axioms)
mk_ide rf is_cat_finite_limit_def
|intro is_cat_finite_limitI|
|dest is_cat_finite_limitD[dest]|
|elim is_cat_finite_limitE[elim]|
lemmas [cat_lim_cs_intros] = is_cat_finite_limitD
lemma (in is_cat_finite_colimit)
is_cat_finite_colimit_axioms'[cat_lim_cs_intros]:
assumes "Ξ±' = Ξ±" and "r' = r" and "π' = π" and "β' = β" and "π' = π"
shows "u : π' >β©Cβ©Fβ©.β©cβ©oβ©lβ©iβ©mβ©.β©fβ©iβ©n r' : π' β¦β¦β©CβΞ±'β β'"
unfolding assms by (rule is_cat_finite_colimit_axioms)
mk_ide rf is_cat_finite_colimit_def[unfolded is_cat_colimit_axioms_def]
|intro is_cat_finite_colimitI|
|dest is_cat_finite_colimitD[dest]|
|elim is_cat_finite_colimitE[elim]|
lemmas [cat_lim_cs_intros] = is_cat_finite_colimitD
textβΉDualityβΊ
lemma (in is_cat_finite_limit) is_cat_finite_colimit_op:
"op_ntcf u : op_cf π >β©Cβ©Fβ©.β©cβ©oβ©lβ©iβ©mβ©.β©fβ©iβ©n r : op_cat π β¦β¦β©CβΞ±β op_cat β"
by
(
cs_concl cs_intro:
is_cat_finite_colimitI cat_op_intros cat_small_cs_intros
)
lemma (in is_cat_finite_limit) is_cat_finite_colimit_op'[cat_op_intros]:
assumes "π' = op_cf π" and "π' = op_cat π" and "β' = op_cat β"
shows "op_ntcf u : π' >β©Cβ©Fβ©.β©cβ©oβ©lβ©iβ©mβ©.β©fβ©iβ©n r : π' β¦β¦β©CβΞ±β β'"
unfolding assms by (rule is_cat_finite_colimit_op)
lemmas [cat_op_intros] = is_cat_finite_limit.is_cat_finite_colimit_op'
lemma (in is_cat_finite_colimit) is_cat_finite_limit_op:
"op_ntcf u : r <β©Cβ©Fβ©.β©lβ©iβ©mβ©.β©fβ©iβ©n op_cf π : op_cat π β¦β¦β©CβΞ±β op_cat β"
by
(
cs_concl cs_intro:
is_cat_finite_limitI cat_op_intros cat_small_cs_intros
)
lemma (in is_cat_finite_colimit) is_cat_finite_colimit_op'[cat_op_intros]:
assumes "π' = op_cf π" and "π' = op_cat π" and "β' = op_cat β"
shows "op_ntcf u : r <β©Cβ©Fβ©.β©lβ©iβ©mβ©.β©fβ©iβ©n π' : π' β¦β¦β©CβΞ±β β'"
unfolding assms by (rule is_cat_finite_limit_op)
lemmas [cat_op_intros] = is_cat_finite_colimit.is_cat_finite_colimit_op'
subsectionβΉProduct and coproductβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉ
The definition of the product object is a specialization of the
definition presented in Chapter III-4 in \cite{mac_lane_categories_2010}.
In the definition presented below, the discrete category that is used in the
definition presented in \cite{mac_lane_categories_2010} is parameterized by
an index set and the functor from the discrete category is
parameterized by a function from the index set to the set of
the objects of the category.
βΊ
locale is_cat_obj_prod =
is_cat_limit Ξ± βΉ:β©C IβΊ β βΉ:β: I A ββΊ P Ο + cf_discrete Ξ± I A β
for Ξ± I A β P Ο
syntax "_is_cat_obj_prod" :: "V β V β V β V β V β V β bool"
(βΉ(_ :/ _ <β©Cβ©Fβ©.β©β _ :/ _ β¦β¦β©CΔ± _)βΊ [51, 51, 51, 51, 51] 51)
translations "Ο : P <β©Cβ©Fβ©.β©β A : I β¦β¦β©CβΞ±β β" β
"CONST is_cat_obj_prod Ξ± I A β P Ο"
locale is_cat_obj_coprod =
is_cat_colimit Ξ± βΉ:β©C IβΊ β βΉ:β: I A ββΊ U Ο + cf_discrete Ξ± I A β
for Ξ± I A β U Ο
syntax "_is_cat_obj_coprod" :: "V β V β V β V β V β V β bool"
(βΉ(_ :/ _ >β©Cβ©Fβ©.β©β _ :/ _ β¦β¦β©CΔ± _)βΊ [51, 51, 51, 51, 51] 51)
translations "Ο : A >β©Cβ©Fβ©.β©β U : I β¦β¦β©CβΞ±β β" β
"CONST is_cat_obj_coprod Ξ± I A β U Ο"
textβΉRules.βΊ
lemma (in is_cat_obj_prod) is_cat_obj_prod_axioms'[cat_lim_cs_intros]:
assumes "Ξ±' = Ξ±" and "P' = P" and "A' = A" and "I' = I" and "β' = β"
shows "Ο : P' <β©Cβ©Fβ©.β©β A' : I' β¦β¦β©CβΞ±'β β'"
unfolding assms by (rule is_cat_obj_prod_axioms)
mk_ide rf is_cat_obj_prod_def
|intro is_cat_obj_prodI|
|dest is_cat_obj_prodD[dest]|
|elim is_cat_obj_prodE[elim]|
lemmas [cat_lim_cs_intros] = is_cat_obj_prodD
lemma (in is_cat_obj_coprod) is_cat_obj_coprod_axioms'[cat_lim_cs_intros]:
assumes "Ξ±' = Ξ±" and "U' = U" and "A' = A" and "I' = I" and "β' = β"
shows "Ο : A' >β©Cβ©Fβ©.β©β U' : I' β¦β¦β©CβΞ±'β β'"
unfolding assms by (rule is_cat_obj_coprod_axioms)
mk_ide rf is_cat_obj_coprod_def
|intro is_cat_obj_coprodI|
|dest is_cat_obj_coprodD[dest]|
|elim is_cat_obj_coprodE[elim]|
lemmas [cat_lim_cs_intros] = is_cat_obj_coprodD
textβΉDuality.βΊ
lemma (in is_cat_obj_prod) is_cat_obj_coprod_op:
"op_ntcf Ο : A >β©Cβ©Fβ©.β©β P : I β¦β¦β©CβΞ±β op_cat β"
using cf_discrete_vdomain_vsubset_Vset
by (intro is_cat_obj_coprodI)
(cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_op_intros)
lemma (in is_cat_obj_prod) is_cat_obj_coprod_op'[cat_op_intros]:
assumes "β' = op_cat β"
shows "op_ntcf Ο : A >β©Cβ©Fβ©.β©β P : I β¦β¦β©CβΞ±β β'"
unfolding assms by (rule is_cat_obj_coprod_op)
lemmas [cat_op_intros] = is_cat_obj_prod.is_cat_obj_coprod_op'
lemma (in is_cat_obj_coprod) is_cat_obj_prod_op:
"op_ntcf Ο : U <β©Cβ©Fβ©.β©β A : I β¦β¦β©CβΞ±β op_cat β"
using cf_discrete_vdomain_vsubset_Vset
by (intro is_cat_obj_prodI)
(cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_op_intros)
lemma (in is_cat_obj_coprod) is_cat_obj_prod_op'[cat_op_intros]:
assumes "β' = op_cat β"
shows "op_ntcf Ο : U <β©Cβ©Fβ©.β©β A : I β¦β¦β©CβΞ±β β'"
unfolding assms by (rule is_cat_obj_prod_op)
lemmas [cat_op_intros] = is_cat_obj_coprod.is_cat_obj_prod_op'
subsubsectionβΉUniversal propertyβΊ
lemma (in is_cat_obj_prod) cat_obj_prod_unique_cone':
assumes "Ο' : P' <β©Cβ©Fβ©.β©cβ©oβ©nβ©e :β: I A β : :β©C I β¦β¦β©CβΞ±β β"
shows "β!f'. f' : P' β¦βββ P β§ (βjββ©βI. Ο'β¦NTMapβ¦β¦jβ¦ = Οβ¦NTMapβ¦β¦jβ¦ ββ©Aβββ f')"
by
(
rule cat_lim_unique_cone'[
OF assms, unfolded the_cat_discrete_components(1)
]
)
lemma (in is_cat_obj_prod) cat_obj_prod_unique:
assumes "Ο' : P' <β©Cβ©Fβ©.β©β A : I β¦β¦β©CβΞ±β β"
shows "β!f'. f' : P' β¦βββ P β§ Ο' = Ο ββ©Nβ©Tβ©Cβ©F ntcf_const (:β©C I) β f'"
by (intro cat_lim_unique[OF is_cat_obj_prodD(1)[OF assms]])
lemma (in is_cat_obj_prod) cat_obj_prod_unique':
assumes "Ο' : P' <β©Cβ©Fβ©.β©β A : I β¦β¦β©CβΞ±β β"
shows "β!f'. f' : P' β¦βββ P β§ (βiββ©βI. Ο'β¦NTMapβ¦β¦iβ¦ = Οβ¦NTMapβ¦β¦iβ¦ ββ©Aβββ f')"
proof-
interpret Ο': is_cat_obj_prod Ξ± I A β P' Ο' by (rule assms(1))
show ?thesis
by
(
rule cat_lim_unique'[
OF Ο'.is_cat_limit_axioms, unfolded the_cat_discrete_components(1)
]
)
qed
lemma (in is_cat_obj_coprod) cat_obj_coprod_unique_cocone':
assumes "Ο' : :β: I A β >β©Cβ©Fβ©.β©cβ©oβ©cβ©oβ©nβ©e U' : :β©C I β¦β¦β©CβΞ±β β"
shows "β!f'. f' : U β¦βββ U' β§ (βjββ©βI. Ο'β¦NTMapβ¦β¦jβ¦ = f' ββ©Aβββ Οβ¦NTMapβ¦β¦jβ¦)"
by
(
rule cat_colim_unique_cocone'[
OF assms, unfolded the_cat_discrete_components(1)
]
)
lemma (in is_cat_obj_coprod) cat_obj_coprod_unique:
assumes "Ο' : A >β©Cβ©Fβ©.β©β U' : I β¦β¦β©CβΞ±β β"
shows "β!f'. f' : U β¦βββ U' β§ Ο' = ntcf_const (:β©C I) β f' ββ©Nβ©Tβ©Cβ©F Ο"
by (intro cat_colim_unique[OF is_cat_obj_coprodD(1)[OF assms]])
lemma (in is_cat_obj_coprod) cat_obj_coprod_unique':
assumes "Ο' : A >β©Cβ©Fβ©.β©β U' : I β¦β¦β©CβΞ±β β"
shows "β!f'. f' : U β¦βββ U' β§ (βjββ©βI. Ο'β¦NTMapβ¦β¦jβ¦ = f' ββ©Aβββ Οβ¦NTMapβ¦β¦jβ¦)"
by
(
rule cat_colim_unique'[
OF is_cat_obj_coprodD(1)[OF assms], unfolded the_cat_discrete_components
]
)
lemma cat_obj_prod_ex_is_arr_isomorphism:
assumes "Ο : P <β©Cβ©Fβ©.β©β A : I β¦β¦β©CβΞ±β β" and "Ο' : P' <β©Cβ©Fβ©.β©β A : I β¦β¦β©CβΞ±β β"
obtains f where "f : P' β¦β©iβ©sβ©oβββ P" and "Ο' = Ο ββ©Nβ©Tβ©Cβ©F ntcf_const (:β©C I) β f"
proof-
interpret Ο: is_cat_obj_prod Ξ± I A β P Ο by (rule assms(1))
interpret Ο': is_cat_obj_prod Ξ± I A β P' Ο' by (rule assms(2))
from that show ?thesis
by
(
elim cat_lim_ex_is_arr_isomorphism[
OF Ο.is_cat_limit_axioms Ο'.is_cat_limit_axioms
]
)
qed
lemma cat_obj_prod_ex_is_arr_isomorphism':
assumes "Ο : P <β©Cβ©Fβ©.β©β A : I β¦β¦β©CβΞ±β β" and "Ο' : P' <β©Cβ©Fβ©.β©β A : I β¦β¦β©CβΞ±β β"
obtains f where "f : P' β¦β©iβ©sβ©oβββ P"
and "βj. j ββ©β I βΉ Ο'β¦NTMapβ¦β¦jβ¦ = Οβ¦NTMapβ¦β¦jβ¦ ββ©Aβββ f"
proof-
interpret Ο: is_cat_obj_prod Ξ± I A β P Ο by (rule assms(1))
interpret Ο': is_cat_obj_prod Ξ± I A β P' Ο' by (rule assms(2))
from that show ?thesis
by
(
elim cat_lim_ex_is_arr_isomorphism'[
OF Ο.is_cat_limit_axioms Ο'.is_cat_limit_axioms,
unfolded the_cat_discrete_components(1)
]
)
qed
lemma cat_obj_coprod_ex_is_arr_isomorphism:
assumes "Ο : A >β©Cβ©Fβ©.β©β U : I β¦β¦β©CβΞ±β β" and "Ο' : A >β©Cβ©Fβ©.β©β U' : I β¦β¦β©CβΞ±β β"
obtains f where "f : U β¦β©iβ©sβ©oβββ U'" and "Ο' = ntcf_const (:β©C I) β f ββ©Nβ©Tβ©Cβ©F Ο"
proof-
interpret Ο: is_cat_obj_coprod Ξ± I A β U Ο by (rule assms(1))
interpret Ο': is_cat_obj_coprod Ξ± I A β U' Ο' by (rule assms(2))
from that show ?thesis
by
(
elim cat_colim_ex_is_arr_isomorphism[
OF Ο.is_cat_colimit_axioms Ο'.is_cat_colimit_axioms
]
)
qed
lemma cat_obj_coprod_ex_is_arr_isomorphism':
assumes "Ο : A >β©Cβ©Fβ©.β©β U : I β¦β¦β©CβΞ±β β" and "Ο' : A >β©Cβ©Fβ©.β©β U' : I β¦β¦β©CβΞ±β β"
obtains f where "f : U β¦β©iβ©sβ©oβββ U'"
and "βj. j ββ©β I βΉ Ο'β¦NTMapβ¦β¦jβ¦ = f ββ©Aβββ Οβ¦NTMapβ¦β¦jβ¦"
proof-
interpret Ο: is_cat_obj_coprod Ξ± I A β U Ο by (rule assms(1))
interpret Ο': is_cat_obj_coprod Ξ± I A β U' Ο' by (rule assms(2))
from that show ?thesis
by
(
elim cat_colim_ex_is_arr_isomorphism'[
OF Ο.is_cat_colimit_axioms Ο'.is_cat_colimit_axioms,
unfolded the_cat_discrete_components(1)
]
)
qed
subsectionβΉFinite product and finite coproductβΊ
locale is_cat_finite_obj_prod = is_cat_obj_prod Ξ± I A β P Ο
for Ξ± I A β P Ο +
assumes cat_fin_obj_prod_index_in_Ο: "I ββ©β Ο"
syntax "_is_cat_finite_obj_prod" :: "V β V β V β V β V β V β bool"
(βΉ(_ :/ _ <β©Cβ©Fβ©.β©ββ©.β©fβ©iβ©n _ :/ _ β¦β¦β©CΔ± _)βΊ [51, 51, 51, 51, 51] 51)
translations "Ο : P <β©Cβ©Fβ©.β©ββ©.β©fβ©iβ©n A : I β¦β¦β©CβΞ±β β" β
"CONST is_cat_finite_obj_prod Ξ± I A β P Ο"
locale is_cat_finite_obj_coprod = is_cat_obj_coprod Ξ± I A β U Ο
for Ξ± I A β U Ο +
assumes cat_fin_obj_coprod_index_in_Ο: "I ββ©β Ο"
syntax "_is_cat_finite_obj_coprod" :: "V β V β V β V β V β V β bool"
(βΉ(_ :/ _ >β©Cβ©Fβ©.β©ββ©.β©fβ©iβ©n _ :/ _ β¦β¦β©CΔ± _)βΊ [51, 51, 51, 51, 51] 51)
translations "Ο : A >β©Cβ©Fβ©.β©ββ©.β©fβ©iβ©n U : I β¦β¦β©CβΞ±β β" β
"CONST is_cat_finite_obj_coprod Ξ± I A β U Ο"
lemma (in is_cat_finite_obj_prod) cat_fin_obj_prod_index_vfinite: "vfinite I"
using cat_fin_obj_prod_index_in_Ο by auto
sublocale is_cat_finite_obj_prod β I: finite_category Ξ± βΉ:β©C IβΊ
by (intro finite_categoryI')
(
auto
simp: NTDom.HomDom.tiny_dg_category the_cat_discrete_components
intro!: cat_fin_obj_prod_index_vfinite
)
lemma (in is_cat_finite_obj_coprod) cat_fin_obj_coprod_index_vfinite:
"vfinite I"
using cat_fin_obj_coprod_index_in_Ο by auto
sublocale is_cat_finite_obj_coprod β I: finite_category Ξ± βΉ:β©C IβΊ
by (intro finite_categoryI')
(
auto
simp: NTDom.HomDom.tiny_dg_category the_cat_discrete_components
intro!: cat_fin_obj_coprod_index_vfinite
)
textβΉRules.βΊ
lemma (in is_cat_finite_obj_prod)
is_cat_finite_obj_prod_axioms'[cat_lim_cs_intros]:
assumes "Ξ±' = Ξ±" and "P' = P" and "A' = A" and "I' = I" and "β' = β"
shows "Ο : P' <β©Cβ©Fβ©.β©ββ©.β©fβ©iβ©n A' : I' β¦β¦β©CβΞ±'β β'"
unfolding assms by (rule is_cat_finite_obj_prod_axioms)
mk_ide rf
is_cat_finite_obj_prod_def[unfolded is_cat_finite_obj_prod_axioms_def]
|intro is_cat_finite_obj_prodI|
|dest is_cat_finite_obj_prodD[dest]|
|elim is_cat_finite_obj_prodE[elim]|
lemmas [cat_lim_cs_intros] = is_cat_finite_obj_prodD
lemma (in is_cat_finite_obj_coprod)
is_cat_finite_obj_coprod_axioms'[cat_lim_cs_intros]:
assumes "Ξ±' = Ξ±" and "U' = U" and "A' = A" and "I' = I" and "β' = β"
shows "Ο : A' >β©Cβ©Fβ©.β©ββ©.β©fβ©iβ©n U' : I' β¦β¦β©CβΞ±'β β'"
unfolding assms by (rule is_cat_finite_obj_coprod_axioms)
mk_ide rf
is_cat_finite_obj_coprod_def[unfolded is_cat_finite_obj_coprod_axioms_def]
|intro is_cat_finite_obj_coprodI|
|dest is_cat_finite_obj_coprodD[dest]|
|elim is_cat_finite_obj_coprodE[elim]|
lemmas [cat_lim_cs_intros] = is_cat_finite_obj_coprodD
textβΉDuality.βΊ
lemma (in is_cat_finite_obj_prod) is_cat_finite_obj_coprod_op:
"op_ntcf Ο : A >β©Cβ©Fβ©.β©ββ©.β©fβ©iβ©n P : I β¦β¦β©CβΞ±β op_cat β"
by (intro is_cat_finite_obj_coprodI)
(
cs_concl
cs_simp: cat_op_simps
cs_intro: cat_fin_obj_prod_index_in_Ο cat_cs_intros cat_op_intros
)
lemma (in is_cat_finite_obj_prod) is_cat_finite_obj_coprod_op'[cat_op_intros]:
assumes "β' = op_cat β"
shows "op_ntcf Ο : A >β©Cβ©Fβ©.β©ββ©.β©fβ©iβ©n P : I β¦β¦β©CβΞ±β β'"
unfolding assms by (rule is_cat_finite_obj_coprod_op)
lemmas [cat_op_intros] = is_cat_finite_obj_prod.is_cat_finite_obj_coprod_op'
lemma (in is_cat_finite_obj_coprod) is_cat_finite_obj_prod_op:
"op_ntcf Ο : U <β©Cβ©Fβ©.β©ββ©.β©fβ©iβ©n A : I β¦β¦β©CβΞ±β op_cat β"
by (intro is_cat_finite_obj_prodI)
(
cs_concl
cs_simp: cat_op_simps
cs_intro: cat_fin_obj_coprod_index_in_Ο cat_cs_intros cat_op_intros
)
lemma (in is_cat_finite_obj_coprod) is_cat_finite_obj_prod_op'[cat_op_intros]:
assumes "β' = op_cat β"
shows "op_ntcf Ο : U <β©Cβ©Fβ©.β©ββ©.β©fβ©iβ©n A : I β¦β¦β©CβΞ±β β'"
unfolding assms by (rule is_cat_finite_obj_prod_op)
lemmas [cat_op_intros] = is_cat_finite_obj_coprod.is_cat_finite_obj_prod_op'
subsectionβΉProduct and coproduct of two objectsβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
locale is_cat_obj_prod_2 = is_cat_obj_prod Ξ± βΉ2β©ββΊ βΉif2 a bβΊ β P Ο
for Ξ± a b β P Ο
syntax "_is_cat_obj_prod_2" :: "V β V β V β V β V β V β bool"
(βΉ(_ :/ _ <β©Cβ©Fβ©.β©Γ {_,_} :/ 2β©C β¦β¦β©CΔ± _)βΊ [51, 51, 51, 51, 51] 51)
translations "Ο : P <β©Cβ©Fβ©.β©Γ {a,b} : 2β©C β¦β¦β©CβΞ±β β" β
"CONST is_cat_obj_prod_2 Ξ± a b β P Ο"
locale is_cat_obj_coprod_2 = is_cat_obj_coprod Ξ± βΉ2β©ββΊ βΉif2 a bβΊ β P Ο
for Ξ± a b β P Ο
syntax "_is_cat_obj_coprod_2" :: "V β V β V β V β V β V β bool"
(βΉ(_ :/ {_,_} >β©Cβ©Fβ©.β©β _ :/ 2β©C β¦β¦β©CΔ± _)βΊ [51, 51, 51, 51, 51] 51)
translations "Ο : {a,b} >β©Cβ©Fβ©.β©β U : 2β©C β¦β¦β©CβΞ±β β" β
"CONST is_cat_obj_coprod_2 Ξ± a b β U Ο"
abbreviation proj_fst where "proj_fst Ο β‘ vpfst (Οβ¦NTMapβ¦)"
abbreviation proj_snd where "proj_snd Ο β‘ vpsnd (Οβ¦NTMapβ¦)"
textβΉRules.βΊ
lemma (in is_cat_obj_prod_2) is_cat_obj_prod_2_axioms'[cat_lim_cs_intros]:
assumes "Ξ±' = Ξ±" and "P' = P" and "a' = a" and "b' = b" and "β' = β"
shows "Ο : P' <β©Cβ©Fβ©.β©Γ {a',b'} : 2β©C β¦β¦β©CβΞ±β β'"
unfolding assms by (rule is_cat_obj_prod_2_axioms)
mk_ide rf is_cat_obj_prod_2_def
|intro is_cat_obj_prod_2I|
|dest is_cat_obj_prod_2D[dest]|
|elim is_cat_obj_prod_2E[elim]|
lemmas [cat_lim_cs_intros] = is_cat_obj_prod_2D
lemma (in is_cat_obj_coprod_2) is_cat_obj_coprod_2_axioms'[cat_lim_cs_intros]:
assumes "Ξ±' = Ξ±" and "P' = P" and "a' = a" and "b' = b" and "β' = β"
shows "Ο : {a',b'} >β©Cβ©Fβ©.β©β P' : 2β©C β¦β¦β©CβΞ±β β'"
unfolding assms by (rule is_cat_obj_coprod_2_axioms)
mk_ide rf is_cat_obj_coprod_2_def
|intro is_cat_obj_coprod_2I|
|dest is_cat_obj_coprod_2D[dest]|
|elim is_cat_obj_coprod_2E[elim]|
lemmas [cat_lim_cs_intros] = is_cat_obj_coprod_2D
textβΉDuality.βΊ
lemma (in is_cat_obj_prod_2) is_cat_obj_coprod_2_op:
"op_ntcf Ο : {a,b} >β©Cβ©Fβ©.β©β P : 2β©C β¦β¦β©CβΞ±β op_cat β"
by (rule is_cat_obj_coprod_2I[OF is_cat_obj_coprod_op])
lemma (in is_cat_obj_prod_2) is_cat_obj_coprod_2_op'[cat_op_intros]:
assumes "β' = op_cat β"
shows "op_ntcf Ο : {a,b} >β©Cβ©Fβ©.β©β P : 2β©C β¦β¦β©CβΞ±β β'"
unfolding assms by (rule is_cat_obj_coprod_2_op)
lemmas [cat_op_intros] = is_cat_obj_prod_2.is_cat_obj_coprod_2_op'
lemma (in is_cat_obj_coprod_2) is_cat_obj_prod_2_op:
"op_ntcf Ο : P <β©Cβ©Fβ©.β©Γ {a,b} : 2β©C β¦β¦β©CβΞ±β op_cat β"
by (rule is_cat_obj_prod_2I[OF is_cat_obj_prod_op])
lemma (in is_cat_obj_coprod_2) is_cat_obj_prod_2_op'[cat_op_intros]:
assumes "β' = op_cat β"
shows "op_ntcf Ο : P <β©Cβ©Fβ©.β©Γ {a,b} : 2β©C β¦β¦β©CβΞ±β β'"
unfolding assms by (rule is_cat_obj_prod_2_op)
lemmas [cat_op_intros] = is_cat_obj_coprod_2.is_cat_obj_prod_2_op'
textβΉProduct/coproduct of two objects is a finite product/coproduct.βΊ
sublocale is_cat_obj_prod_2 β is_cat_finite_obj_prod Ξ± βΉ2β©ββΊ βΉif2 a bβΊ β P Ο
proof(intro is_cat_finite_obj_prodI)
show "2β©β ββ©β Ο" by simp
qed (cs_concl cs_simp: two[symmetric] cs_intro: cat_lim_cs_intros)
sublocale is_cat_obj_coprod_2 β is_cat_finite_obj_coprod Ξ± βΉ2β©ββΊ βΉif2 a bβΊ β P Ο
proof(intro is_cat_finite_obj_coprodI)
show "2β©β ββ©β Ο" by simp
qed (cs_concl cs_simp: two[symmetric] cs_intro: cat_lim_cs_intros)
textβΉElementary properties.βΊ
lemma (in is_cat_obj_prod_2) cat_obj_prod_2_lr_in_Obj:
shows cat_obj_prod_2_left_in_Obj[cat_lim_cs_intros]: "a ββ©β ββ¦Objβ¦"
and cat_obj_prod_2_right_in_Obj[cat_lim_cs_intros]: "b ββ©β ββ¦Objβ¦"
proof-
have 0: "0 ββ©β 2β©β" and 1: "1β©β ββ©β 2β©β" by simp_all
show "a ββ©β ββ¦Objβ¦" and "b ββ©β ββ¦Objβ¦"
by
(
intro
cf_discrete_selector_vrange[OF 0, simplified]
cf_discrete_selector_vrange[OF 1, simplified]
)+
qed
lemmas [cat_lim_cs_intros] = is_cat_obj_prod_2.cat_obj_prod_2_lr_in_Obj
lemma (in is_cat_obj_coprod_2) cat_obj_coprod_2_lr_in_Obj:
shows cat_obj_coprod_2_left_in_Obj[cat_lim_cs_intros]: "a ββ©β ββ¦Objβ¦"
and cat_obj_coprod_2_right_in_Obj[cat_lim_cs_intros]: "b ββ©β ββ¦Objβ¦"
by
(
intro is_cat_obj_prod_2.cat_obj_prod_2_lr_in_Obj[
OF is_cat_obj_prod_2_op, unfolded cat_op_simps
]
)+
lemmas [cat_lim_cs_intros] = is_cat_obj_coprod_2.cat_obj_coprod_2_lr_in_Obj
textβΉUtilities/help lemmas.βΊ
lemma helper_I2_proj_fst_proj_snd_iff:
"(βjββ©β2β©β. Ο'β¦NTMapβ¦β¦jβ¦ = Οβ¦NTMapβ¦β¦jβ¦ ββ©Aβββ f') β·
(proj_fst Ο' = proj_fst Ο ββ©Aβββ f' β§ proj_snd Ο' = proj_snd Ο ββ©Aβββ f')"
unfolding two by auto
lemma helper_I2_proj_fst_proj_snd_iff':
"(βjββ©β2β©β. Ο'β¦NTMapβ¦β¦jβ¦ = f' ββ©Aβββ Οβ¦NTMapβ¦β¦jβ¦) β·
(proj_fst Ο' = f' ββ©Aβββ proj_fst Ο β§ proj_snd Ο' = f' ββ©Aβββ proj_snd Ο)"
unfolding two by auto
subsubsectionβΉUniversal propertyβΊ
lemma (in is_cat_obj_prod_2) cat_obj_prod_2_unique_cone':
assumes "Ο' : P' <β©Cβ©Fβ©.β©cβ©oβ©nβ©e :β: (2β©β) (if2 a b) β : :β©C (2β©β) β¦β¦β©CβΞ±β β"
shows
"β!f'. f' : P' β¦βββ P β§
proj_fst Ο' = proj_fst Ο ββ©Aβββ f' β§
proj_snd Ο' = proj_snd Ο ββ©Aβββ f'"
by
(
rule cat_obj_prod_unique_cone'[
OF assms, unfolded helper_I2_proj_fst_proj_snd_iff
]
)
lemma (in is_cat_obj_prod_2) cat_obj_prod_2_unique:
assumes "Ο' : P' <β©Cβ©Fβ©.β©Γ {a,b} : 2β©C β¦β¦β©CβΞ±β β"
shows "β!f'. f' : P' β¦βββ P β§ Ο' = Ο ββ©Nβ©Tβ©Cβ©F ntcf_const (:β©C (2β©β)) β f'"
by (rule cat_obj_prod_unique[OF is_cat_obj_prod_2D[OF assms]])
lemma (in is_cat_obj_prod_2) cat_obj_prod_2_unique':
assumes "Ο' : P' <β©Cβ©Fβ©.β©Γ {a,b} : 2β©C β¦β¦β©CβΞ±β β"
shows
"β!f'. f' : P' β¦βββ P β§
proj_fst Ο' = proj_fst Ο ββ©Aβββ f' β§
proj_snd Ο' = proj_snd Ο ββ©Aβββ f'"
by
(
rule cat_obj_prod_unique'[
OF is_cat_obj_prod_2D[OF assms],
unfolded helper_I2_proj_fst_proj_snd_iff
]
)
lemma (in is_cat_obj_coprod_2) cat_obj_coprod_2_unique_cocone':
assumes "Ο' : :β: (2β©β) (if2 a b) β >β©Cβ©Fβ©.β©cβ©oβ©cβ©oβ©nβ©e P' : :β©C (2β©β) β¦β¦β©CβΞ±β β"
shows
"β!f'. f' : P β¦βββ P' β§
proj_fst Ο' = f' ββ©Aβββ proj_fst Ο β§
proj_snd Ο' = f' ββ©Aβββ proj_snd Ο"
by
(
rule cat_obj_coprod_unique_cocone'[
OF assms, unfolded helper_I2_proj_fst_proj_snd_iff'
]
)
lemma (in is_cat_obj_coprod_2) cat_obj_coprod_2_unique:
assumes "Ο' : {a,b} >β©Cβ©Fβ©.β©β P' : 2β©C β¦β¦β©CβΞ±β β"
shows "β!f'. f' : P β¦βββ P' β§ Ο' = ntcf_const (:β©C (2β©β)) β f' ββ©Nβ©Tβ©Cβ©F Ο"
by (rule cat_obj_coprod_unique[OF is_cat_obj_coprod_2D[OF assms]])
lemma (in is_cat_obj_coprod_2) cat_obj_coprod_2_unique':
assumes "Ο' : {a,b} >β©Cβ©Fβ©.β©β P' : 2β©C β¦β¦β©CβΞ±β β"
shows
"β!f'. f' : P β¦βββ P' β§
proj_fst Ο' = f' ββ©Aβββ proj_fst Ο β§
proj_snd Ο' = f' ββ©Aβββ proj_snd Ο"
by
(
rule cat_obj_coprod_unique'[
OF is_cat_obj_coprod_2D[OF assms],
unfolded helper_I2_proj_fst_proj_snd_iff'
]
)
lemma cat_obj_prod_2_ex_is_arr_isomorphism:
assumes "Ο : P <β©Cβ©Fβ©.β©Γ {a,b} : 2β©C β¦β¦β©CβΞ±β β"
and "Ο' : P' <β©Cβ©Fβ©.β©Γ {a,b} : 2β©C β¦β¦β©CβΞ±β β"
obtains f where "f : P' β¦β©iβ©sβ©oβββ P" and "Ο' = Ο ββ©Nβ©Tβ©Cβ©F ntcf_const (:β©C (2β©β)) β f"
proof-
interpret Ο: is_cat_obj_prod_2 Ξ± a b β P Ο by (rule assms(1))
interpret Ο': is_cat_obj_prod_2 Ξ± a b β P' Ο' by (rule assms(2))
from that show ?thesis
by
(
elim cat_obj_prod_ex_is_arr_isomorphism[
OF Ο.is_cat_obj_prod_axioms Ο'.is_cat_obj_prod_axioms
]
)
qed
lemma cat_obj_coprod_2_ex_is_arr_isomorphism:
assumes "Ο : {a,b} >β©Cβ©Fβ©.β©β U : 2β©C β¦β¦β©CβΞ±β β"
and "Ο' : {a,b} >β©Cβ©Fβ©.β©β U' : 2β©C β¦β¦β©CβΞ±β β"
obtains f where "f : U β¦β©iβ©sβ©oβββ U'" and "Ο' = ntcf_const (:β©C (2β©β)) β f ββ©Nβ©Tβ©Cβ©F Ο"
proof-
interpret Ο: is_cat_obj_coprod_2 Ξ± a b β U Ο by (rule assms(1))
interpret Ο': is_cat_obj_coprod_2 Ξ± a b β U' Ο' by (rule assms(2))
from that show ?thesis
by
(
elim cat_obj_coprod_ex_is_arr_isomorphism[
OF Ο.is_cat_obj_coprod_axioms Ο'.is_cat_obj_coprod_axioms
]
)
qed
subsectionβΉPullbacks and pushoutsβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉ
The definitions and the elementary properties of the pullbacks and the
pushouts can be found, for example, in Chapter III-3 and Chapter III-4 in
\cite{mac_lane_categories_2010}.
βΊ
locale is_cat_pullback =
is_cat_limit Ξ± βΉββββ©CβΊ β βΉβ¨πβπ€βπ¬βπ£βπβ©β©Cβ©FββββΊ X x +
cf_scospan Ξ± π π€ π¬ π£ π β
for Ξ± π π€ π¬ π£ π β X x
syntax "_is_cat_pullback" :: "V β V β V β V β V β V β V β V β V β bool"
(βΉ(_ :/ _ <β©Cβ©Fβ©.β©pβ©b _β_β_β_β_ β¦β¦β©CΔ± _)βΊ [51, 51, 51, 51, 51, 51, 51, 51] 51)
translations "x : X <β©Cβ©Fβ©.β©pβ©b πβπ€βπ¬βπ£βπ β¦β¦β©CβΞ±β β" β
"CONST is_cat_pullback Ξ± π π€ π¬ π£ π β X x"
locale is_cat_pushout =
is_cat_colimit Ξ± βΉββββ©CβΊ β βΉβ¨πβπ€βπ¬βπ£βπβ©β©Cβ©FββββΊ X x +
cf_sspan Ξ± π π€ π¬ π£ π β
for Ξ± π π€ π¬ π£ π β X x
syntax "_is_cat_pushout" :: "V β V β V β V β V β V β V β V β V β bool"
(βΉ(_ :/ _β_β_β_β_ >β©Cβ©Fβ©.β©pβ©o _ β¦β¦β©CΔ± _)βΊ [51, 51, 51, 51, 51, 51, 51, 51] 51)
translations "x : πβπ€βπ¬βπ£βπ >β©Cβ©Fβ©.β©pβ©o X β¦β¦β©CβΞ±β β" β
"CONST is_cat_pushout Ξ± π π€ π¬ π£ π β X x"
textβΉRules.βΊ
lemma (in is_cat_pullback) is_cat_pullback_axioms'[cat_lim_cs_intros]:
assumes "Ξ±' = Ξ±"
and "π' = π"
and "π€' = π€"
and "π¬' = π¬"
and "π£' = π£"
and "π' = π"
and "β' = β"
and "X' = X"
shows "x : X' <β©Cβ©Fβ©.β©pβ©b π'βπ€'βπ¬'βπ£'βπ' β¦β¦β©CβΞ±'β β'"
unfolding assms by (rule is_cat_pullback_axioms)
mk_ide rf is_cat_pullback_def
|intro is_cat_pullbackI|
|dest is_cat_pullbackD[dest]|
|elim is_cat_pullbackE[elim]|
lemmas [cat_lim_cs_intros] = is_cat_pullbackD
lemma (in is_cat_pushout) is_cat_pushout_axioms'[cat_lim_cs_intros]:
assumes "Ξ±' = Ξ±"
and "π' = π"
and "π€' = π€"
and "π¬' = π¬"
and "π£' = π£"
and "π' = π"
and "β' = β"
and "X' = X"
shows "x : π'βπ€'βπ¬'βπ£'βπ' >β©Cβ©Fβ©.β©pβ©o X' β¦β¦β©CβΞ±'β β'"
unfolding assms by (rule is_cat_pushout_axioms)
mk_ide rf is_cat_pushout_def
|intro is_cat_pushoutI|
|dest is_cat_pushoutD[dest]|
|elim is_cat_pushoutE[elim]|
lemmas [cat_lim_cs_intros] = is_cat_pushoutD
textβΉDuality.βΊ
lemma (in is_cat_pullback) is_cat_pushout_op:
"op_ntcf x : πβπ€βπ¬βπ£βπ >β©Cβ©Fβ©.β©pβ©o X β¦β¦β©CβΞ±β op_cat β"
by (intro is_cat_pushoutI)
(cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)+
lemma (in is_cat_pullback) is_cat_pushout_op'[cat_op_intros]:
assumes "β' = op_cat β"
shows "op_ntcf x : πβπ€βπ¬βπ£βπ >β©Cβ©Fβ©.β©pβ©o X β¦β¦β©CβΞ±β β'"
unfolding assms by (rule is_cat_pushout_op)
lemmas [cat_op_intros] = is_cat_pullback.is_cat_pushout_op'
lemma (in is_cat_pushout) is_cat_pullback_op:
"op_ntcf x : X <β©Cβ©Fβ©.β©pβ©b πβπ€βπ¬βπ£βπ β¦β¦β©CβΞ±β op_cat β"
by (intro is_cat_pullbackI)
(cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)+
lemma (in is_cat_pushout) is_cat_pullback_op'[cat_op_intros]:
assumes "β' = op_cat β"
shows "op_ntcf x : X <β©Cβ©Fβ©.β©pβ©b πβπ€βπ¬βπ£βπ β¦β¦β©CβΞ±β β'"
unfolding assms by (rule is_cat_pullback_op)
lemmas [cat_op_intros] = is_cat_pushout.is_cat_pullback_op'
textβΉElementary properties.βΊ
lemma cat_cone_cospan:
assumes "x : X <β©Cβ©Fβ©.β©cβ©oβ©nβ©e β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fβββ : ββββ©C β¦β¦β©CβΞ±β β"
and "cf_scospan Ξ± π π€ π¬ π£ π β"
shows "xβ¦NTMapβ¦β¦π¬β©Sβ©Sβ¦ = π€ ββ©Aβββ xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦"
and "xβ¦NTMapβ¦β¦π¬β©Sβ©Sβ¦ = π£ ββ©Aβββ xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦"
and "π€ ββ©Aβββ xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦ = π£ ββ©Aβββ xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦"
proof-
interpret x: is_cat_cone Ξ± X βΉββββ©CβΊ β βΉβ¨πβπ€βπ¬βπ£βπβ©β©Cβ©FββββΊ x
by (rule assms(1))
interpret cospan: cf_scospan Ξ± π π€ π¬ π£ π β by (rule assms(2))
have π€β©Sβ©S: "π€β©Sβ©S : πβ©Sβ©S β¦βββββ©Cβ π¬β©Sβ©S" and π£β©Sβ©S: "π£β©Sβ©S : πβ©Sβ©S β¦βββββ©Cβ π¬β©Sβ©S"
by (cs_concl cs_simp: cs_intro: cat_ss_cs_intros)+
from x.ntcf_Comp_commute[OF π€β©Sβ©S] π€β©Sβ©S π£β©Sβ©S show
"xβ¦NTMapβ¦β¦π¬β©Sβ©Sβ¦ = π€ ββ©Aβββ xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦"
by (cs_prems cs_simp: cat_ss_cs_simps cat_cs_simps cs_intro: cat_cs_intros)
moreover from x.ntcf_Comp_commute[OF π£β©Sβ©S] π€β©Sβ©S π£β©Sβ©S show
"xβ¦NTMapβ¦β¦π¬β©Sβ©Sβ¦ = π£ ββ©Aβββ xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦"
by (cs_prems cs_simp: cat_ss_cs_simps cat_cs_simps cs_intro: cat_cs_intros)
ultimately show "π€ ββ©Aβββ xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦ = π£ ββ©Aβββ xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦" by simp
qed
lemma (in is_cat_pullback) cat_pb_cone_cospan:
shows "xβ¦NTMapβ¦β¦π¬β©Sβ©Sβ¦ = π€ ββ©Aβββ xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦"
and "xβ¦NTMapβ¦β¦π¬β©Sβ©Sβ¦ = π£ ββ©Aβββ xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦"
and "π€ ββ©Aβββ xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦ = π£ ββ©Aβββ xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦"
by (allβΉrule cat_cone_cospan[OF is_cat_cone_axioms cf_scospan_axioms]βΊ)
lemma cat_cocone_span:
assumes "x : β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fβββ >β©Cβ©Fβ©.β©cβ©oβ©cβ©oβ©nβ©e X : ββββ©C β¦β¦β©CβΞ±β β"
and "cf_sspan Ξ± π π€ π¬ π£ π β"
shows "xβ¦NTMapβ¦β¦π¬β©Sβ©Sβ¦ = xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦ ββ©Aβββ π€"
and "xβ¦NTMapβ¦β¦π¬β©Sβ©Sβ¦ = xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦ ββ©Aβββ π£"
and "xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦ ββ©Aβββ π€ = xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦ ββ©Aβββ π£"
proof-
interpret x: is_cat_cocone Ξ± X βΉββββ©CβΊ β βΉβ¨πβπ€βπ¬βπ£βπβ©β©Cβ©FββββΊ x
by (rule assms(1))
interpret span: cf_sspan Ξ± π π€ π¬ π£ π β by (rule assms(2))
note op =
cat_cone_cospan
[
OF
x.is_cat_cone_op[unfolded cat_op_simps]
span.cf_scospan_op,
unfolded cat_op_simps
]
from op(1) show "xβ¦NTMapβ¦β¦π¬β©Sβ©Sβ¦ = xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦ ββ©Aβββ π€"
by
(
cs_prems
cs_simp: cat_ss_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_ss_cs_intros
)
moreover from op(2) show "xβ¦NTMapβ¦β¦π¬β©Sβ©Sβ¦ = xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦ ββ©Aβββ π£"
by
(
cs_prems
cs_simp: cat_ss_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_ss_cs_intros
)
ultimately show "xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦ ββ©Aβββ π€ = xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦ ββ©Aβββ π£" by auto
qed
lemma (in is_cat_pushout) cat_po_cocone_span:
shows "xβ¦NTMapβ¦β¦π¬β©Sβ©Sβ¦ = xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦ ββ©Aβββ π€"
and "xβ¦NTMapβ¦β¦π¬β©Sβ©Sβ¦ = xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦ ββ©Aβββ π£"
and "xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦ ββ©Aβββ π€ = xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦ ββ©Aβββ π£"
by (allβΉrule cat_cocone_span[OF is_cat_cocone_axioms cf_sspan_axioms]βΊ)
subsubsectionβΉUniversal propertyβΊ
lemma is_cat_pullbackI':
assumes "x : X <β©Cβ©Fβ©.β©cβ©oβ©nβ©e β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fβββ : ββββ©C β¦β¦β©CβΞ±β β"
and "cf_scospan Ξ± π π€ π¬ π£ π β"
and "βx' X'.
x' : X' <β©Cβ©Fβ©.β©cβ©oβ©nβ©e β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fβββ : ββββ©C β¦β¦β©CβΞ±β β βΉ
β!f'.
f' : X' β¦βββ X β§
x'β¦NTMapβ¦β¦πβ©Sβ©Sβ¦ = xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦ ββ©Aβββ f' β§
x'β¦NTMapβ¦β¦πβ©Sβ©Sβ¦ = xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦ ββ©Aβββ f'"
shows "x : X <β©Cβ©Fβ©.β©pβ©b πβπ€βπ¬βπ£βπ β¦β¦β©CβΞ±β β"
proof(intro is_cat_pullbackI is_cat_limitI')
show "x : X <β©Cβ©Fβ©.β©cβ©oβ©nβ©e β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fβββ : ββββ©C β¦β¦β©CβΞ±β β"
by (rule assms(1))
interpret x: is_cat_cone Ξ± X βΉββββ©CβΊ β βΉβ¨πβπ€βπ¬βπ£βπβ©β©Cβ©FββββΊ x
by (rule assms(1))
show "cf_scospan Ξ± π π€ π¬ π£ π β" by (rule assms(2))
interpret cospan: cf_scospan Ξ± π π€ π¬ π£ π β by (rule assms(2))
fix u' r' assume prems:
"u' : r' <β©Cβ©Fβ©.β©cβ©oβ©nβ©e β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fβββ : ββββ©C β¦β¦β©CβΞ±β β"
interpret u': is_cat_cone Ξ± r' βΉββββ©CβΊ β βΉβ¨πβπ€βπ¬βπ£βπβ©β©Cβ©FββββΊ u'
by (rule prems)
from assms(3)[OF prems] obtain f'
where f': "f' : r' β¦βββ X"
and u'_πβ©Sβ©S: "u'β¦NTMapβ¦β¦πβ©Sβ©Sβ¦ = xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦ ββ©Aβββ f'"
and u'_πβ©Sβ©S: "u'β¦NTMapβ¦β¦πβ©Sβ©Sβ¦ = xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦ ββ©Aβββ f'"
and unique_f': "βf''.
β¦
f'' : r' β¦βββ X;
u'β¦NTMapβ¦β¦πβ©Sβ©Sβ¦ = xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦ ββ©Aβββ f'';
u'β¦NTMapβ¦β¦πβ©Sβ©Sβ¦ = xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦ ββ©Aβββ f''
β§ βΉ f'' = f'"
by metis
show "β!f'. f' : r' β¦βββ X β§ u' = x ββ©Nβ©Tβ©Cβ©F ntcf_const ββββ©C β f'"
proof(intro ex1I conjI; (elim conjE)?)
show "u' = x ββ©Nβ©Tβ©Cβ©F ntcf_const ββββ©C β f'"
proof(rule ntcf_eqI)
show "u' : cf_const ββββ©C β r' β¦β©Cβ©F β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fβββ : ββββ©C β¦β¦β©CβΞ±β β"
by (rule u'.is_ntcf_axioms)
from f' show
"x ββ©Nβ©Tβ©Cβ©F ntcf_const ββββ©C β f' :
cf_const ββββ©C β r' β¦β©Cβ©F β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fβββ :
ββββ©C β¦β¦β©CβΞ±β β"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from f' have dom_rhs:
"πβ©β ((x ββ©Nβ©Tβ©Cβ©F ntcf_const ββββ©C β f')β¦NTMapβ¦) = ββββ©Cβ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "u'β¦NTMapβ¦ = (x ββ©Nβ©Tβ©Cβ©F ntcf_const ββββ©C β f')β¦NTMapβ¦"
proof(rule vsv_eqI, unfold cat_cs_simps dom_rhs)
fix a assume prems': "a ββ©β ββββ©Cβ¦Objβ¦"
from this f' x.is_ntcf_axioms show
"u'β¦NTMapβ¦β¦aβ¦ = (x ββ©Nβ©Tβ©Cβ©F ntcf_const ββββ©C β f')β¦NTMapβ¦β¦aβ¦"
by (elim the_cat_scospan_ObjE; simp only:)
(
cs_concl
cs_simp:
cat_cs_simps cat_ss_cs_simps
u'_πβ©Sβ©S u'_πβ©Sβ©S
cat_cone_cospan(1)[OF assms(1,2)]
cat_cone_cospan(1)[OF prems assms(2)]
cs_intro: cat_cs_intros cat_ss_cs_intros
)+
qed (cs_concl cs_intro: cat_cs_intros | auto)+
qed simp_all
fix f'' assume prems:
"f'' : r' β¦βββ X" "u' = x ββ©Nβ©Tβ©Cβ©F ntcf_const ββββ©C β f''"
have πβ©Sβ©S: "πβ©Sβ©S ββ©β ββββ©Cβ¦Objβ¦" and πβ©Sβ©S: "πβ©Sβ©S ββ©β ββββ©Cβ¦Objβ¦"
by (cs_concl cs_simp: cs_intro: cat_ss_cs_intros)+
have "u'β¦NTMapβ¦β¦aβ¦ = xβ¦NTMapβ¦β¦aβ¦ ββ©Aβββ f''" if "a ββ©β ββββ©Cβ¦Objβ¦" for a
proof-
from prems(2) have
"u'β¦NTMapβ¦β¦aβ¦ = (x ββ©Nβ©Tβ©Cβ©F ntcf_const ββββ©C β f'')β¦NTMapβ¦β¦aβ¦"
by simp
from this that prems(1) show "u'β¦NTMapβ¦β¦aβ¦ = xβ¦NTMapβ¦β¦aβ¦ ββ©Aβββ f''"
by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
from unique_f'[OF prems(1) this[OF πβ©Sβ©S] this[OF πβ©Sβ©S]] show "f'' = f'".
qed (intro f')
qed
lemma is_cat_pushoutI':
assumes "x : β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fβββ >β©Cβ©Fβ©.β©cβ©oβ©cβ©oβ©nβ©e X : ββββ©C β¦β¦β©CβΞ±β β"
and "cf_sspan Ξ± π π€ π¬ π£ π β"
and "βx' X'. x' : β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fβββ >β©Cβ©Fβ©.β©cβ©oβ©cβ©oβ©nβ©e X' : ββββ©C β¦β¦β©CβΞ±β β βΉ
β!f'.
f' : X β¦βββ X' β§
x'β¦NTMapβ¦β¦πβ©Sβ©Sβ¦ = f' ββ©Aβββ xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦ β§
x'β¦NTMapβ¦β¦πβ©Sβ©Sβ¦ = f' ββ©Aβββ xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦"
shows "x : πβπ€βπ¬βπ£βπ >β©Cβ©Fβ©.β©pβ©o X β¦β¦β©CβΞ±β β"
proof-
interpret x: is_cat_cocone Ξ± X βΉββββ©CβΊ β βΉβ¨πβπ€βπ¬βπ£βπβ©β©Cβ©FββββΊ x
by (rule assms(1))
interpret span: cf_sspan Ξ± π π€ π¬ π£ π β by (rule assms(2))
have assms_3':
"β!f'.
f' : X β¦βββ X' β§
x'β¦NTMapβ¦β¦πβ©Sβ©Sβ¦ = xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦ ββ©Aβop_cat ββ f' β§
x'β¦NTMapβ¦β¦πβ©Sβ©Sβ¦ = xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦ ββ©Aβop_cat ββ f'"
if "x' : X' <β©Cβ©Fβ©.β©cβ©oβ©nβ©e β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fβop_cat ββ : ββββ©C β¦β¦β©CβΞ±β op_cat β"
for x' X'
proof-
from that(1) have [cat_op_simps]:
"f' : X β¦βββ X' β§
x'β¦NTMapβ¦β¦πβ©Sβ©Sβ¦ = xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦ ββ©Aβop_cat ββ f' β§
x'β¦NTMapβ¦β¦πβ©Sβ©Sβ¦ = xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦ ββ©Aβop_cat ββ f' β·
f' : X β¦βββ X' β§
x'β¦NTMapβ¦β¦πβ©Sβ©Sβ¦ = f' ββ©Aβββ xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦ β§
x'β¦NTMapβ¦β¦πβ©Sβ©Sβ¦ = f' ββ©Aβββ xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦"
for f'
by (intro iffI conjI; (elim conjE)?)
(
cs_concl
cs_simp: category.op_cat_Comp[symmetric] cat_op_simps cat_cs_simps
cs_intro: cat_cs_intros cat_ss_cs_intros
)+
interpret x':
is_cat_cone Ξ± X' βΉββββ©CβΊ βΉop_cat ββΊ βΉβ¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fβop_cat βββΊ x'
by (rule that)
show ?thesis
unfolding cat_op_simps
by
(
rule assms(3)[
OF x'.is_cat_cocone_op[unfolded cat_op_simps],
unfolded cat_op_simps
]
)
qed
interpret op_x: is_cat_pullback Ξ± π π€ π¬ π£ π βΉop_cat ββΊ X βΉop_ntcf xβΊ
using
is_cat_pullbackI'
[
OF x.is_cat_cone_op[unfolded cat_op_simps]
span.cf_scospan_op,
unfolded cat_op_simps,
OF assms_3'
]
by simp
show "x : πβπ€βπ¬βπ£βπ >β©Cβ©Fβ©.β©pβ©o X β¦β¦β©CβΞ±β β"
by (rule op_x.is_cat_pushout_op[unfolded cat_op_simps])
qed
lemma (in is_cat_pullback) cat_pb_unique_cone:
assumes "x' : X' <β©Cβ©Fβ©.β©cβ©oβ©nβ©e β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fβββ : ββββ©C β¦β¦β©CβΞ±β β"
shows "β!f'.
f' : X' β¦βββ X β§
x'β¦NTMapβ¦β¦πβ©Sβ©Sβ¦ = xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦ ββ©Aβββ f' β§
x'β¦NTMapβ¦β¦πβ©Sβ©Sβ¦ = xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦ ββ©Aβββ f'"
proof-
interpret x': is_cat_cone Ξ± X' βΉββββ©CβΊ β βΉβ¨πβπ€βπ¬βπ£βπβ©β©Cβ©FββββΊ x'
by (rule assms)
from cat_lim_unique_cone[OF assms] obtain f'
where f': "f' : X' β¦βββ X"
and x'_def: "x' = x ββ©Nβ©Tβ©Cβ©F ntcf_const ββββ©C β f'"
and unique_f': "βf''.
β¦ f'' : X' β¦βββ X; x' = x ββ©Nβ©Tβ©Cβ©F ntcf_const ββββ©C β f'' β§ βΉ
f'' = f'"
by auto
have πβ©Sβ©S: "πβ©Sβ©S ββ©β ββββ©Cβ¦Objβ¦" and πβ©Sβ©S: "πβ©Sβ©S ββ©β ββββ©Cβ¦Objβ¦"
by (cs_concl cs_intro: cat_ss_cs_intros)+
show ?thesis
proof(intro ex1I conjI; (elim conjE)?)
show "f' : X' β¦βββ X" by (rule f')
have "x'β¦NTMapβ¦β¦aβ¦ = xβ¦NTMapβ¦β¦aβ¦ ββ©Aβββ f'" if "a ββ©β ββββ©Cβ¦Objβ¦" for a
proof-
from x'_def have
"x'β¦NTMapβ¦β¦aβ¦ = (x ββ©Nβ©Tβ©Cβ©F ntcf_const ββββ©C β f')β¦NTMapβ¦β¦aβ¦"
by simp
from this that f' show "x'β¦NTMapβ¦β¦aβ¦ = xβ¦NTMapβ¦β¦aβ¦ ββ©Aβββ f'"
by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
from this[OF πβ©Sβ©S] this[OF πβ©Sβ©S] show
"x'β¦NTMapβ¦β¦πβ©Sβ©Sβ¦ = xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦ ββ©Aβββ f'"
"x'β¦NTMapβ¦β¦πβ©Sβ©Sβ¦ = xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦ ββ©Aβββ f'"
by auto
fix f'' assume prems':
"f'' : X' β¦βββ X"
"x'β¦NTMapβ¦β¦πβ©Sβ©Sβ¦ = xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦ ββ©Aβββ f''"
"x'β¦NTMapβ¦β¦πβ©Sβ©Sβ¦ = xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦ ββ©Aβββ f''"
have "x' = x ββ©Nβ©Tβ©Cβ©F ntcf_const ββββ©C β f''"
proof(rule ntcf_eqI)
show "x' : cf_const ββββ©C β X' β¦β©Cβ©F β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fβββ : ββββ©C β¦β¦β©CβΞ±β β"
by (rule x'.is_ntcf_axioms)
from prems'(1) show
"x ββ©Nβ©Tβ©Cβ©F ntcf_const ββββ©C β f'' :
cf_const ββββ©C β X' β¦β©Cβ©F β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fβββ :
ββββ©C β¦β¦β©CβΞ±β β"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
have dom_lhs: "πβ©β (x'β¦NTMapβ¦) = ββββ©Cβ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps)
from prems'(1) have dom_rhs:
"πβ©β ((x ββ©Nβ©Tβ©Cβ©F ntcf_const ββββ©C β f'')β¦NTMapβ¦) = ββββ©Cβ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "x'β¦NTMapβ¦ = (x ββ©Nβ©Tβ©Cβ©F ntcf_const ββββ©C β f'')β¦NTMapβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix a assume prems'': "a ββ©β ββββ©Cβ¦Objβ¦"
from this prems'(1) show
"x'β¦NTMapβ¦β¦aβ¦ = (x ββ©Nβ©Tβ©Cβ©F ntcf_const ββββ©C β f'')β¦NTMapβ¦β¦aβ¦"
by (elim the_cat_scospan_ObjE; simp only:)
(
cs_concl
cs_simp:
prems'(2,3)
cat_cone_cospan(1,2)[OF assms cf_scospan_axioms]
cat_pb_cone_cospan
cat_ss_cs_simps cat_cs_simps
cs_intro: cat_ss_cs_intros cat_cs_intros
)+
qed (auto simp: cat_cs_intros)
qed simp_all
from unique_f'[OF prems'(1) this] show "f'' = f'".
qed
qed
lemma (in is_cat_pullback) cat_pb_unique:
assumes "x' : X' <β©Cβ©Fβ©.β©pβ©b πβπ€βπ¬βπ£βπ β¦β¦β©CβΞ±β β"
shows "β!f'. f' : X' β¦βββ X β§ x' = x ββ©Nβ©Tβ©Cβ©F ntcf_const ββββ©C β f'"
by (rule cat_lim_unique[OF is_cat_pullbackD(1)[OF assms]])
lemma (in is_cat_pullback) cat_pb_unique':
assumes "x' : X' <β©Cβ©Fβ©.β©pβ©b πβπ€βπ¬βπ£βπ β¦β¦β©CβΞ±β β"
shows "β!f'.
f' : X' β¦βββ X β§
x'β¦NTMapβ¦β¦πβ©Sβ©Sβ¦ = xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦ ββ©Aβββ f' β§
x'β¦NTMapβ¦β¦πβ©Sβ©Sβ¦ = xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦ ββ©Aβββ f'"
proof-
interpret x': is_cat_pullback Ξ± π π€ π¬ π£ π β X' x' by (rule assms(1))
show ?thesis by (rule cat_pb_unique_cone[OF x'.is_cat_cone_axioms])
qed
lemma (in is_cat_pushout) cat_po_unique_cocone:
assumes "x' : β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fβββ >β©Cβ©Fβ©.β©cβ©oβ©cβ©oβ©nβ©e X' : ββββ©C β¦β¦β©CβΞ±β β"
shows "β!f'.
f' : X β¦βββ X' β§
x'β¦NTMapβ¦β¦πβ©Sβ©Sβ¦ = f' ββ©Aβββ xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦ β§
x'β¦NTMapβ¦β¦πβ©Sβ©Sβ¦ = f' ββ©Aβββ xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦"
proof-
interpret x': is_cat_cocone Ξ± X' βΉββββ©CβΊ β βΉβ¨πβπ€βπ¬βπ£βπβ©β©Cβ©FββββΊ x'
by (rule assms(1))
have [cat_op_simps]:
"f' : X β¦βββ X' β§
x'β¦NTMapβ¦β¦πβ©Sβ©Sβ¦ = xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦ ββ©Aβop_cat ββ f' β§
x'β¦NTMapβ¦β¦πβ©Sβ©Sβ¦ = xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦ ββ©Aβop_cat ββ f' β·
f' : X β¦βββ X' β§
x'β¦NTMapβ¦β¦πβ©Sβ©Sβ¦ = f' ββ©Aβββ xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦ β§
x'β¦NTMapβ¦β¦πβ©Sβ©Sβ¦ = f' ββ©Aβββ xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦"
for f'
by (intro iffI conjI; (elim conjE)?)
(
cs_concl
cs_simp: category.op_cat_Comp[symmetric] cat_op_simps cat_cs_simps
cs_intro: cat_cs_intros cat_ss_cs_intros
)+
show ?thesis
by
(
rule is_cat_pullback.cat_pb_unique_cone[
OF is_cat_pullback_op x'.is_cat_cone_op[unfolded cat_op_simps],
unfolded cat_op_simps
]
)
qed
lemma (in is_cat_pushout) cat_po_unique:
assumes "x' : πβπ€βπ¬βπ£βπ >β©Cβ©Fβ©.β©pβ©o X' β¦β¦β©CβΞ±β β"
shows "β!f'. f' : X β¦βββ X' β§ x' = ntcf_const ββββ©C β f' ββ©Nβ©Tβ©Cβ©F x"
by (rule cat_colim_unique[OF is_cat_pushoutD(1)[OF assms]])
lemma (in is_cat_pushout) cat_po_unique':
assumes "x' : πβπ€βπ¬βπ£βπ >β©Cβ©Fβ©.β©pβ©o X' β¦β¦β©CβΞ±β β"
shows "β!f'.
f' : X β¦βββ X' β§
x'β¦NTMapβ¦β¦πβ©Sβ©Sβ¦ = f' ββ©Aβββ xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦ β§
x'β¦NTMapβ¦β¦πβ©Sβ©Sβ¦ = f' ββ©Aβββ xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦"
proof-
interpret x': is_cat_pushout Ξ± π π€ π¬ π£ π β X' x' by (rule assms(1))
show ?thesis by (rule cat_po_unique_cocone[OF x'.is_cat_cocone_axioms])
qed
lemma cat_pullback_ex_is_arr_isomorphism:
assumes "x : X <β©Cβ©Fβ©.β©pβ©b πβπ€βπ¬βπ£βπ β¦β¦β©CβΞ±β β"
and "x' : X' <β©Cβ©Fβ©.β©pβ©b πβπ€βπ¬βπ£βπ β¦β¦β©CβΞ±β β"
obtains f where "f : X' β¦β©iβ©sβ©oβββ X"
and "x' = x ββ©Nβ©Tβ©Cβ©F ntcf_const ββββ©C β f"
proof-
interpret x: is_cat_pullback Ξ± π π€ π¬ π£ π β X x by (rule assms(1))
interpret x': is_cat_pullback Ξ± π π€ π¬ π£ π β X' x' by (rule assms(2))
from that show ?thesis
by
(
elim cat_lim_ex_is_arr_isomorphism[
OF x.is_cat_limit_axioms x'.is_cat_limit_axioms
]
)
qed
lemma cat_pullback_ex_is_arr_isomorphism':
assumes "x : X <β©Cβ©Fβ©.β©pβ©b πβπ€βπ¬βπ£βπ β¦β¦β©CβΞ±β β"
and "x' : X' <β©Cβ©Fβ©.β©pβ©b πβπ€βπ¬βπ£βπ β¦β¦β©CβΞ±β β"
obtains f where "f : X' β¦β©iβ©sβ©oβββ X"
and "x'β¦NTMapβ¦β¦πβ©Sβ©Sβ¦ = xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦ ββ©Aβββ f"
and "x'β¦NTMapβ¦β¦πβ©Sβ©Sβ¦ = xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦ ββ©Aβββ f"
proof-
interpret x: is_cat_pullback Ξ± π π€ π¬ π£ π β X x by (rule assms(1))
interpret x': is_cat_pullback Ξ± π π€ π¬ π£ π β X' x' by (rule assms(2))
obtain f where f: "f : X' β¦β©iβ©sβ©oβββ X"
and "j ββ©β ββββ©Cβ¦Objβ¦ βΉ x'β¦NTMapβ¦β¦jβ¦ = xβ¦NTMapβ¦β¦jβ¦ ββ©Aβββ f" for j
by
(
elim cat_lim_ex_is_arr_isomorphism'[
OF x.is_cat_limit_axioms x'.is_cat_limit_axioms
]
)
then have
"x'β¦NTMapβ¦β¦πβ©Sβ©Sβ¦ = xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦ ββ©Aβββ f"
"x'β¦NTMapβ¦β¦πβ©Sβ©Sβ¦ = xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦ ββ©Aβββ f"
by (auto simp: cat_ss_cs_intros)
with f show ?thesis using that by simp
qed
lemma cat_pushout_ex_is_arr_isomorphism:
assumes "x : πβπ€βπ¬βπ£βπ >β©Cβ©Fβ©.β©pβ©o X β¦β¦β©CβΞ±β β"
and "x' : πβπ€βπ¬βπ£βπ >β©Cβ©Fβ©.β©pβ©o X' β¦β¦β©CβΞ±β β"
obtains f where "f : X β¦β©iβ©sβ©oβββ X'"
and "x' = ntcf_const ββββ©C β f ββ©Nβ©Tβ©Cβ©F x"
proof-
interpret x: is_cat_pushout Ξ± π π€ π¬ π£ π β X x by (rule assms(1))
interpret x': is_cat_pushout Ξ± π π€ π¬ π£ π β X' x' by (rule assms(2))
from that show ?thesis
by
(
elim cat_colim_ex_is_arr_isomorphism[
OF x.is_cat_colimit_axioms x'.is_cat_colimit_axioms
]
)
qed
lemma cat_pushout_ex_is_arr_isomorphism':
assumes "x : πβπ€βπ¬βπ£βπ >β©Cβ©Fβ©.β©pβ©o X β¦β¦β©CβΞ±β β"
and "x' : πβπ€βπ¬βπ£βπ >β©Cβ©Fβ©.β©pβ©o X' β¦β¦β©CβΞ±β β"
obtains f where "f : X β¦β©iβ©sβ©oβββ X'"
and "x'β¦NTMapβ¦β¦πβ©Sβ©Sβ¦ = f ββ©Aβββ xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦"
and "x'β¦NTMapβ¦β¦πβ©Sβ©Sβ¦ = f ββ©Aβββ xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦"
proof-
interpret x: is_cat_pushout Ξ± π π€ π¬ π£ π β X x by (rule assms(1))
interpret x': is_cat_pushout Ξ± π π€ π¬ π£ π β X' x' by (rule assms(2))
obtain f where f: "f : X β¦β©iβ©sβ©oβββ X'"
and "j ββ©β ββββ©Cβ¦Objβ¦ βΉ x'β¦NTMapβ¦β¦jβ¦ = f ββ©Aβββ xβ¦NTMapβ¦β¦jβ¦" for j
by
(
elim cat_colim_ex_is_arr_isomorphism'[
OF x.is_cat_colimit_axioms x'.is_cat_colimit_axioms,
unfolded the_cat_parallel_components(1)
]
)
then have "x'β¦NTMapβ¦β¦πβ©Sβ©Sβ¦ = f ββ©Aβββ xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦"
and "x'β¦NTMapβ¦β¦πβ©Sβ©Sβ¦ = f ββ©Aβββ xβ¦NTMapβ¦β¦πβ©Sβ©Sβ¦"
by (auto simp: cat_ss_cs_intros)
with f show ?thesis using that by simp
qed
subsectionβΉEqualizers and coequalizersβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉ
See \cite{noauthor_wikipedia_2001}\footnote{
\url{https://en.wikipedia.org/wiki/Equaliser_(mathematics)}
}.
βΊ
locale is_cat_equalizer =
is_cat_limit Ξ± βΉβββ©C πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©LβΊ β βΉβββββ β πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©L π π π€ π£βΊ E Ξ΅
for Ξ± π π π€ π£ β E Ξ΅ +
assumes cat_eq_π€[cat_lim_cs_intros]: "π€ : π β¦βββ π"
and cat_eq_π£[cat_lim_cs_intros]: "π£ : π β¦βββ π"
syntax "_is_cat_equalizer" :: "V β V β V β V β V β V β V β V β bool"
(βΉ(_ :/ _ <β©Cβ©Fβ©.β©eβ©q '(_,_,_,_') :/ βββ§2β©C β¦β¦β©CΔ± _)βΊ [51, 51, 51, 51, 51, 51] 51)
translations "Ξ΅ : E <β©Cβ©Fβ©.β©eβ©q (π,π,π€,π£) : βββ§2β©C β¦β¦β©CβΞ±β β" β
"CONST is_cat_equalizer Ξ± π π π€ π£ β E Ξ΅"
locale is_cat_coequalizer =
is_cat_colimit Ξ± βΉβββ©C πβ©Pβ©L πβ©Pβ©L π£β©Pβ©L π€β©Pβ©LβΊ β βΉβββββ β πβ©Pβ©L πβ©Pβ©L π£β©Pβ©L π€β©Pβ©L π π π£ π€βΊ E Ξ΅
for Ξ± π π π€ π£ β E Ξ΅ +
assumes cat_coeq_π€[cat_lim_cs_intros]: "π€ : π β¦βββ π"
and cat_coeq_π£[cat_lim_cs_intros]: "π£ : π β¦βββ π"
syntax "_is_cat_coequalizer" :: "V β V β V β V β V β V β V β V β bool"
(βΉ(_ :/ '(_,_,_,_') >β©Cβ©Fβ©.β©cβ©oβ©eβ©q _ :/ βββ§2β©C β¦β¦β©CΔ± _)βΊ [51, 51, 51, 51, 51, 51] 51)
translations "Ξ΅ : (π,π,π€,π£) >β©Cβ©Fβ©.β©cβ©oβ©eβ©q E : βββ§2β©C β¦β¦β©CβΞ±β β" β
"CONST is_cat_coequalizer Ξ± π π π€ π£ β E Ξ΅"
textβΉRules.βΊ
lemma (in is_cat_equalizer) is_cat_equalizer_axioms'[cat_lim_cs_intros]:
assumes "Ξ±' = Ξ±"
and "E' = E"
and "π' = π"
and "π' = π"
and "π€' = π€"
and "π£' = π£"
and "β' = β"
shows "Ξ΅ : E' <β©Cβ©Fβ©.β©eβ©q (π',π',π€',π£') : βββ§2β©C β¦β¦β©CβΞ±'β β'"
unfolding assms by (rule is_cat_equalizer_axioms)
mk_ide rf is_cat_equalizer_def[unfolded is_cat_equalizer_axioms_def]
|intro is_cat_equalizerI|
|dest is_cat_equalizerD[dest]|
|elim is_cat_equalizerE[elim]|
lemmas [cat_lim_cs_intros] = is_cat_equalizerD(1)
lemma (in is_cat_coequalizer) is_cat_coequalizer_axioms'[cat_lim_cs_intros]:
assumes "Ξ±' = Ξ±"
and "E' = E"
and "π' = π"
and "π' = π"
and "π€' = π€"
and "π£' = π£"
and "β' = β"
shows "Ξ΅ : (π',π',π€',π£') >β©Cβ©Fβ©.β©cβ©oβ©eβ©q E' : βββ§2β©C β¦β¦β©CβΞ±'β β'"
unfolding assms by (rule is_cat_coequalizer_axioms)
mk_ide rf is_cat_coequalizer_def[unfolded is_cat_coequalizer_axioms_def]
|intro is_cat_coequalizerI|
|dest is_cat_coequalizerD[dest]|
|elim is_cat_coequalizerE[elim]|
lemmas [cat_lim_cs_intros] = is_cat_coequalizerD(1)
textβΉElementary properties.βΊ
sublocale is_cat_equalizer β cf_parallel Ξ± πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©L π π π€ π£ β
by (intro cf_parallelI cat_parallelI)
(simp_all add: cat_parallel_cs_intros cat_lim_cs_intros cat_cs_intros)
sublocale is_cat_coequalizer β cf_parallel Ξ± πβ©Pβ©L πβ©Pβ©L π£β©Pβ©L π€β©Pβ©L π π π£ π€ β
by (intro cf_parallelI cat_parallelI)
(
simp_all add:
cat_parallel_cs_intros cat_lim_cs_intros cat_cs_intros
cat_PL_ineq[symmetric]
)
textβΉDuality.βΊ
lemma (in is_cat_equalizer) is_cat_coequalizer_op:
"op_ntcf Ξ΅ : (π,π,π€,π£) >β©Cβ©Fβ©.β©cβ©oβ©eβ©q E : βββ§2β©C β¦β¦β©CβΞ±β op_cat β"
by (intro is_cat_coequalizerI)
(cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros cat_lim_cs_intros)+
lemma (in is_cat_equalizer) is_cat_coequalizer_op'[cat_op_intros]:
assumes "β' = op_cat β"
shows "op_ntcf Ξ΅ : (π,π,π€,π£) >β©Cβ©Fβ©.β©cβ©oβ©eβ©q E : βββ§2β©C β¦β¦β©CβΞ±β β'"
unfolding assms by (rule is_cat_coequalizer_op)
lemmas [cat_op_intros] = is_cat_equalizer.is_cat_coequalizer_op'
lemma (in is_cat_coequalizer) is_cat_equalizer_op:
"op_ntcf Ξ΅ : E <β©Cβ©Fβ©.β©eβ©q (π,π,π€,π£) : βββ§2β©C β¦β¦β©CβΞ±β op_cat β"
by (intro is_cat_equalizerI)
(
cs_concl
cs_simp: cat_op_simps
cs_intro: cat_cs_intros cat_op_intros cat_lim_cs_intros
)+
lemma (in is_cat_coequalizer) is_cat_equalizer_op'[cat_op_intros]:
assumes "β' = op_cat β"
shows "op_ntcf Ξ΅ : E <β©Cβ©Fβ©.β©eβ©q (π,π,π€,π£) : βββ§2β©C β¦β¦β©CβΞ±β β'"
unfolding assms by (rule is_cat_equalizer_op)
lemmas [cat_op_intros] = is_cat_coequalizer.is_cat_equalizer_op'
textβΉElementary properties.βΊ
lemma cf_parallel_if_is_cat_cone:
assumes "Ξ΅ :
E <β©Cβ©Fβ©.β©cβ©oβ©nβ©e βββββ β πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©L π π π€ π£ : βββ©C πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©L β¦β¦β©CβΞ±β β"
and "π€ : π β¦βββ π"
and "π£ : π β¦βββ π"
shows "cf_parallel Ξ± πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©L π π π€ π£ β"
proof-
let ?II = βΉβββ©C πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©LβΊ and ?II_II = βΉβββββ β πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©L π π π€ π£βΊ
interpret is_cat_cone Ξ± E ?II β ?II_II Ξ΅ by (rule assms(1))
show ?thesis
by (intro cf_parallelI cat_parallelI)
(
simp_all add:
assms cat_parallel_cs_intros cat_lim_cs_intros cat_cs_intros
)
qed
lemma cf_parallel_if_is_cat_cocone:
assumes "Ξ΅' :
βββββ β πβ©Pβ©L πβ©Pβ©L π£β©Pβ©L π€β©Pβ©L π π π£ π€ >β©Cβ©Fβ©.β©cβ©oβ©cβ©oβ©nβ©e E' : βββ©C πβ©Pβ©L πβ©Pβ©L π£β©Pβ©L π€β©Pβ©L β¦β¦β©CβΞ±β β"
and "π€ : π β¦βββ π"
and "π£ : π β¦βββ π"
shows "cf_parallel Ξ± πβ©Pβ©L πβ©Pβ©L π£β©Pβ©L π€β©Pβ©L π π π£ π€ β"
proof-
let ?II = βΉβββ©C πβ©Pβ©L πβ©Pβ©L π£β©Pβ©L π€β©Pβ©LβΊ and ?II_II = βΉβββββ β πβ©Pβ©L πβ©Pβ©L π£β©Pβ©L π€β©Pβ©L π π π£ π€βΊ
interpret is_cat_cocone Ξ± E' ?II β ?II_II Ξ΅' by (rule assms(1))
show ?thesis
by (intro cf_parallelI cat_parallelI)
(
simp_all add:
assms
cat_parallel_cs_intros
cat_lim_cs_intros
cat_cs_intros
cat_PL_ineq[symmetric]
)
qed
lemma (in category) cat_cf_parallel_cat_equalizer:
assumes "π€ : π β¦βββ π" and "π£ : π β¦βββ π"
shows "cf_parallel Ξ± πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©L π π π€ π£ β"
using assms
by (intro cf_parallelI cat_parallelI)
(auto simp: cat_parallel_cs_intros cat_cs_intros)
lemma (in category) cat_cf_parallel_cat_coequalizer:
assumes "π€ : π β¦βββ π" and "π£ : π β¦βββ π"
shows "cf_parallel Ξ± πβ©Pβ©L πβ©Pβ©L π£β©Pβ©L π€β©Pβ©L π π π£ π€ β"
using assms
by (intro cf_parallelI cat_parallelI)
(simp_all add: cat_parallel_cs_intros cat_cs_intros cat_PL_ineq[symmetric])
lemma cat_cone_cf_par_eps_NTMap_app:
assumes "Ξ΅ :
E <β©Cβ©Fβ©.β©cβ©oβ©nβ©e βββββ β πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©L π π π€ π£ : βββ©C πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©L β¦β¦β©CβΞ±β β"
and "π€ : π β¦βββ π"
and "π£ : π β¦βββ π"
shows
"Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ = π€ ββ©Aβββ Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦"
"Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ = π£ ββ©Aβββ Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦"
proof-
let ?II = βΉβββ©C πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©LβΊ and ?II_II = βΉβββββ β πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©L π π π€ π£βΊ
interpret Ξ΅: is_cat_cone Ξ± E ?II β ?II_II Ξ΅ by (rule assms(1))
from assms(2,3) have π: "π ββ©β ββ¦Objβ¦" and π: "π ββ©β ββ¦Objβ¦" by auto
interpret par: cf_parallel Ξ± πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©L π π π€ π£ β
by (intro cf_parallel_if_is_cat_cone, rule assms) (auto intro: assms π π)
have π€β©Pβ©L: "π€β©Pβ©L : πβ©Pβ©L β¦ββββ©C πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©Lβ πβ©Pβ©L"
and π£β©Pβ©L: "π£β©Pβ©L : πβ©Pβ©L β¦ββββ©C πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©Lβ πβ©Pβ©L"
by
(
simp_all add:
par.the_cat_parallel_is_arr_πππ€ par.the_cat_parallel_is_arr_πππ£
)
from Ξ΅.ntcf_Comp_commute[OF π€β©Pβ©L] show "Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ = π€ ββ©Aβββ Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦"
by
(
cs_prems
cs_simp: cat_parallel_cs_simps cat_cs_simps
cs_intro: cat_cs_intros cat_parallel_cs_intros
)
from Ξ΅.ntcf_Comp_commute[OF π£β©Pβ©L] show "Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ = π£ ββ©Aβββ Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦"
by
(
cs_prems
cs_simp: cat_parallel_cs_simps cat_cs_simps
cs_intro: cat_cs_intros cat_parallel_cs_intros
)
qed
lemma cat_cocone_cf_par_eps_NTMap_app:
assumes "Ξ΅ :
βββββ β πβ©Pβ©L πβ©Pβ©L π£β©Pβ©L π€β©Pβ©L π π π£ π€ >β©Cβ©Fβ©.β©cβ©oβ©cβ©oβ©nβ©e E : βββ©C πβ©Pβ©L πβ©Pβ©L π£β©Pβ©L π€β©Pβ©L β¦β¦β©CβΞ±β β"
and "π€ : π β¦βββ π"
and "π£ : π β¦βββ π"
shows
"Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ = Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ ββ©Aβββ π€"
"Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ = Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ ββ©Aβββ π£"
proof-
let ?II = βΉβββ©C πβ©Pβ©L πβ©Pβ©L π£β©Pβ©L π€β©Pβ©LβΊ and ?II_II = βΉβββββ β πβ©Pβ©L πβ©Pβ©L π£β©Pβ©L π€β©Pβ©L π π π£ π€βΊ
interpret Ξ΅: is_cat_cocone Ξ± E ?II β ?II_II Ξ΅ by (rule assms(1))
from assms(2,3) have π: "π ββ©β ββ¦Objβ¦" and π: "π ββ©β ββ¦Objβ¦" by auto
interpret par: cf_parallel Ξ± πβ©Pβ©L πβ©Pβ©L π£β©Pβ©L π€β©Pβ©L π π π£ π€ β
by (intro cf_parallel_if_is_cat_cocone, rule assms) (auto intro: assms π π)
note Ξ΅_NTMap_app =
cat_cone_cf_par_eps_NTMap_app[
OF Ξ΅.is_cat_cone_op[unfolded cat_op_simps],
unfolded cat_op_simps,
OF assms(2,3)
]
from Ξ΅_NTMap_app show Ξ΅_NTMap_app:
"Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ = Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ ββ©Aβββ π€"
"Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ = Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ ββ©Aβββ π£"
by
(
cs_concl
cs_simp: cat_parallel_cs_simps category.op_cat_Comp[symmetric]
cs_intro: cat_cs_intros cat_parallel_cs_intros
)+
qed
lemma (in is_cat_equalizer) cat_eq_2_eps_NTMap_app:
"Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ = π€ ββ©Aβββ Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦"
"Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ = π£ ββ©Aβββ Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦"
by
(
intro cat_cone_cf_par_eps_NTMap_app[
OF is_cat_cone_axioms cat_eq_π€ cat_eq_π£
]
)+
lemma (in is_cat_coequalizer) cat_coeq_2_eps_NTMap_app:
"Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ = Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ ββ©Aβββ π€"
"Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ = Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ ββ©Aβββ π£"
by
(
intro cat_cocone_cf_par_eps_NTMap_app[
OF is_cat_cocone_axioms cat_coeq_π€ cat_coeq_π£
]
)+
lemma (in is_cat_equalizer) cat_eq_Comp_eq:
"π€ ββ©Aβββ Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ = π£ ββ©Aβββ Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦"
"π£ ββ©Aβββ Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ = π€ ββ©Aβββ Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦"
unfolding cat_eq_2_eps_NTMap_app[symmetric] by simp_all
lemma (in is_cat_coequalizer) cat_coeq_Comp_eq:
"Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ ββ©Aβββ π€ = Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ ββ©Aβββ π£"
"Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ ββ©Aβββ π£ = Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ ββ©Aβββ π€"
unfolding cat_coeq_2_eps_NTMap_app[symmetric] by simp_all
subsubsectionβΉUniversal propertyβΊ
lemma is_cat_equalizerI':
assumes "Ξ΅ :
E <β©Cβ©Fβ©.β©cβ©oβ©nβ©e βββββ β πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©L π π π€ π£ : βββ©C πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©L β¦β¦β©CβΞ±β β"
and "π€ : π β¦βββ π"
and "π£ : π β¦βββ π"
and "βΞ΅' E'. Ξ΅' :
E' <β©Cβ©Fβ©.β©cβ©oβ©nβ©e βββββ β πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©L π π π€ π£ :
βββ©C πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©L β¦β¦β©CβΞ±β β βΉ
β!f'. f' : E' β¦βββ E β§ Ξ΅'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ = Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ ββ©Aβββ f'"
shows "Ξ΅ : E <β©Cβ©Fβ©.β©eβ©q (π,π,π€,π£) : βββ§2β©C β¦β¦β©CβΞ±β β"
proof-
let ?II = βΉβββ©C πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©LβΊ and ?II_II = βΉβββββ β πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©L π π π€ π£βΊ
interpret Ξ΅: is_cat_cone Ξ± E ?II β ?II_II Ξ΅ by (rule assms(1))
interpret β: cf_parallel Ξ± πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©L π π π€ π£ β
by (rule Ξ΅.NTDom.HomCod.cat_cf_parallel_cat_equalizer[OF assms(2,3)])
show ?thesis
proof(intro is_cat_equalizerI is_cat_limitI' assms(1-3))
fix u' r' assume prems: "u' : r' <β©Cβ©Fβ©.β©cβ©oβ©nβ©e ?II_II : ?II β¦β¦β©CβΞ±β β"
interpret u': is_cat_cone Ξ± r' ?II β ?II_II u' by (rule prems)
from assms(4)[OF prems] obtain f'
where f': "f' : r' β¦βββ E"
and u'_NTMap_app_π: "u'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ = Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ ββ©Aβββ f'"
and unique_f':
"βf''.
β¦
f'' : r' β¦βββ E;
u'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ = Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ ββ©Aβββ f''
β§ βΉ f'' = f'"
by metis
show "β!f'. f' : r' β¦βββ E β§ u' = Ξ΅ ββ©Nβ©Tβ©Cβ©F ntcf_const ?II β f'"
proof(intro ex1I conjI; (elim conjE)?)
show "u' = Ξ΅ ββ©Nβ©Tβ©Cβ©F ntcf_const ?II β f'"
proof(rule ntcf_eqI)
show "u' : cf_const ?II β r' β¦β©Cβ©F ?II_II : ?II β¦β¦β©CβΞ±β β"
by (rule u'.is_ntcf_axioms)
from f' show "Ξ΅ ββ©Nβ©Tβ©Cβ©F ntcf_const ?II β f' :
cf_const ?II β r' β¦β©Cβ©F ?II_II : ?II β¦β¦β©CβΞ±β β"
by
(
cs_concl
cs_simp: cat_cs_simps cat_ss_cs_simps
cs_intro: cat_cs_intros cat_ss_cs_intros
)
have dom_lhs: "πβ©β (u'β¦NTMapβ¦) = ?IIβ¦Objβ¦"
unfolding cat_cs_simps by simp
from f' have dom_rhs:
"πβ©β ((Ξ΅ ββ©Nβ©Tβ©Cβ©F ntcf_const ?II β f')β¦NTMapβ¦) = ?IIβ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "u'β¦NTMapβ¦ = (Ξ΅ ββ©Nβ©Tβ©Cβ©F ntcf_const ?II β f')β¦NTMapβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix a assume prems': "a ββ©β ?IIβ¦Objβ¦"
note [cat_parallel_cs_simps] =
cat_cone_cf_par_eps_NTMap_app[OF u'.is_cat_cone_axioms assms(2-3)]
cat_cone_cf_par_eps_NTMap_app[OF assms(1-3)]
u'_NTMap_app_π
from prems' f' assms(2,3) show
"u'β¦NTMapβ¦β¦aβ¦ = (Ξ΅ ββ©Nβ©Tβ©Cβ©F ntcf_const ?II β f')β¦NTMapβ¦β¦aβ¦"
by (elim the_cat_parallel_ObjE; simp only:)
(
cs_concl
cs_simp: cat_parallel_cs_simps cat_cs_simps
cs_intro: cat_cs_intros cat_parallel_cs_intros
)
qed (cs_concl cs_intro: V_cs_intros cat_cs_intros)+
qed simp_all
fix f'' assume prems'':
"f'' : r' β¦βββ E" "u' = Ξ΅ ββ©Nβ©Tβ©Cβ©F ntcf_const ?II β f''"
from prems''(2) have u'_NTMap_a:
"u'β¦NTMapβ¦β¦aβ¦ = (Ξ΅ ββ©Nβ©Tβ©Cβ©F ntcf_const ?II β f'')β¦NTMapβ¦β¦aβ¦"
for a
by simp
have "u'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ = Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ ββ©Aβββ f''"
using u'_NTMap_a[of πβ©Pβ©L] prems''(1)
by
(
cs_prems
cs_simp: cat_parallel_cs_simps cat_cs_simps
cs_intro: cat_parallel_cs_intros cat_cs_intros
)
from unique_f'[OF prems''(1) this] show "f'' = f'".
qed (rule f')
qed
qed
lemma is_cat_coequalizerI':
assumes "Ξ΅ :
βββββ β πβ©Pβ©L πβ©Pβ©L π£β©Pβ©L π€β©Pβ©L π π π£ π€ >β©Cβ©Fβ©.β©cβ©oβ©cβ©oβ©nβ©e E :
βββ©C πβ©Pβ©L πβ©Pβ©L π£β©Pβ©L π€β©Pβ©L β¦β¦β©CβΞ±β β"
and "π€ : π β¦βββ π"
and "π£ : π β¦βββ π"
and "βΞ΅' E'. Ξ΅' :
βββββ β πβ©Pβ©L πβ©Pβ©L π£β©Pβ©L π€β©Pβ©L π π π£ π€ >β©Cβ©Fβ©.β©cβ©oβ©cβ©oβ©nβ©e E' :
βββ©C πβ©Pβ©L πβ©Pβ©L π£β©Pβ©L π€β©Pβ©L β¦β¦β©CβΞ±β β βΉ
β!f'. f' : E β¦βββ E' β§ Ξ΅'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ = f' ββ©Aβββ Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦"
shows "Ξ΅ : (π,π,π€,π£) >β©Cβ©Fβ©.β©cβ©oβ©eβ©q E : βββ§2β©C β¦β¦β©CβΞ±β β"
proof-
let ?op_II = βΉβββ©C πβ©Pβ©L πβ©Pβ©L π£β©Pβ©L π€β©Pβ©LβΊ
and ?op_II_II = βΉβββββ β πβ©Pβ©L πβ©Pβ©L π£β©Pβ©L π€β©Pβ©L π π π£ π€βΊ
and ?II = βΉβββ©C πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©LβΊ
and ?II_II = βΉβββββ (op_cat β) πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©L π π π€ π£βΊ
interpret Ξ΅: is_cat_cocone Ξ± E ?op_II β ?op_II_II Ξ΅ by (rule assms(1))
interpret par: cf_parallel Ξ± πβ©Pβ©L πβ©Pβ©L π£β©Pβ©L π€β©Pβ©L π π π£ π€ β
by (rule Ξ΅.NTDom.HomCod.cat_cf_parallel_cat_coequalizer[OF assms(2,3)])
interpret op_par: cf_parallel Ξ± πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©L π π π€ π£ βΉop_cat ββΊ
by (rule par.cf_parallel_op)
have assms_4':
"β!f'. f' : E β¦βββ E' β§ Ξ΅'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ = Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ ββ©Aβop_cat ββ f'"
if "Ξ΅' : E' <β©Cβ©Fβ©.β©cβ©oβ©nβ©e ?II_II : ?II β¦β¦β©CβΞ±β op_cat β" for Ξ΅' E'
proof-
have [cat_op_simps]:
"f' : E β¦βββ E' β§ Ξ΅'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ = Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ ββ©Aβop_cat ββ f' β·
f' : E β¦βββ E' β§ Ξ΅'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ = f' ββ©Aβββ Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦"
for f'
by (intro iffI conjI; (elim conjE)?)
(
cs_concl
cs_simp: category.op_cat_Comp[symmetric] cat_op_simps cat_cs_simps
cs_intro: cat_cs_intros cat_parallel_cs_intros
)+
interpret Ξ΅': is_cat_cone Ξ± E' ?II βΉop_cat ββΊ ?II_II Ξ΅' by (rule that)
show ?thesis
unfolding cat_op_simps
by
(
rule assms(4)[
OF Ξ΅'.is_cat_cocone_op[unfolded cat_op_simps],
unfolded cat_op_simps
]
)
qed
interpret op_Ξ΅: is_cat_equalizer Ξ± π π π€ π£ βΉop_cat ββΊ E βΉop_ntcf Ξ΅βΊ
by
(
rule
is_cat_equalizerI'
[
OF Ξ΅.is_cat_cone_op[unfolded cat_op_simps],
unfolded cat_op_simps,
OF assms(2,3) assms_4'
]
)
show ?thesis by (rule op_Ξ΅.is_cat_coequalizer_op[unfolded cat_op_simps])
qed
lemma (in is_cat_equalizer) cat_eq_unique_cone:
assumes "Ξ΅' :
E' <β©Cβ©Fβ©.β©cβ©oβ©nβ©e βββββ β πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©L π π π€ π£ : βββ©C πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©L β¦β¦β©CβΞ±β β"
(is βΉΞ΅' : E' <β©Cβ©Fβ©.β©cβ©oβ©nβ©e ?II_II : ?II β¦β¦β©CβΞ±β ββΊ)
shows "β!f'. f' : E' β¦βββ E β§ Ξ΅'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ = Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ ββ©Aβββ f'"
proof-
interpret Ξ΅': is_cat_cone Ξ± E' ?II β ?II_II Ξ΅' by (rule assms(1))
from cat_lim_unique_cone[OF assms(1)] obtain f' where f': "f' : E' β¦βββ E"
and Ξ΅'_def: "Ξ΅' = Ξ΅ ββ©Nβ©Tβ©Cβ©F ntcf_const ?II β f'"
and unique:
"β¦ f'' : E' β¦βββ E; Ξ΅' = Ξ΅ ββ©Nβ©Tβ©Cβ©F ntcf_const ?II β f'' β§ βΉ f'' = f'"
for f''
by auto
show ?thesis
proof(intro ex1I conjI; (elim conjE)?)
show f': "f' : E' β¦βββ E" by (rule f')
from Ξ΅'_def have "Ξ΅'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ = (Ξ΅ ββ©Nβ©Tβ©Cβ©F ntcf_const ?II β f')β¦NTMapβ¦β¦πβ©Pβ©Lβ¦"
by simp
from this f' show Ξ΅'_NTMap_app_I: "Ξ΅'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ = Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ ββ©Aβββ f'"
by
(
cs_prems
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_parallel_cs_intros
)
fix f'' assume prems:
"f'' : E' β¦βββ E" "Ξ΅'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ = Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ ββ©Aβββ f''"
have "Ξ΅' = Ξ΅ ββ©Nβ©Tβ©Cβ©F ntcf_const ?II β f''"
proof(rule ntcf_eqI[OF ])
show "Ξ΅' : cf_const ?II β E' β¦β©Cβ©F ?II_II : ?II β¦β¦β©CβΞ±β β"
by (rule Ξ΅'.is_ntcf_axioms)
from f' prems(1) show "Ξ΅ ββ©Nβ©Tβ©Cβ©F ntcf_const ?II β f'' :
cf_const ?II β E' β¦β©Cβ©F ?II_II : ?II β¦β¦β©CβΞ±β β"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "Ξ΅'β¦NTMapβ¦ = (Ξ΅ ββ©Nβ©Tβ©Cβ©F ntcf_const ?II β f'')β¦NTMapβ¦"
proof(rule vsv_eqI, unfold cat_cs_simps)
show "vsv ((Ξ΅ ββ©Nβ©Tβ©Cβ©F ntcf_const ?II β f'')β¦NTMapβ¦)"
by (cs_concl cs_intro: cat_cs_intros)
from prems(1) show
"?IIβ¦Objβ¦ = πβ©β ((Ξ΅ ββ©Nβ©Tβ©Cβ©F ntcf_const ?II β f'')β¦NTMapβ¦)"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
fix a assume prems': "a ββ©β ?IIβ¦Objβ¦"
note [cat_cs_simps] =
cat_eq_2_eps_NTMap_app
cat_cone_cf_par_eps_NTMap_app[
OF Ξ΅'.is_cat_cone_axioms cf_parallel_π€' cf_parallel_π£'
]
from prems' prems(1) have [cat_cs_simps]:
"Ξ΅'β¦NTMapβ¦β¦aβ¦ = Ξ΅β¦NTMapβ¦β¦aβ¦ ββ©Aβββ f''"
by (elim the_cat_parallel_ObjE; simp only:)
(
cs_concl
cs_simp: cat_cs_simps cat_parallel_cs_simps prems(2)
cs_intro: cat_cs_intros cat_parallel_cs_intros
)+
from prems' prems show
"Ξ΅'β¦NTMapβ¦β¦aβ¦ = (Ξ΅ ββ©Nβ©Tβ©Cβ©F ntcf_const ?II β f'')β¦NTMapβ¦β¦aβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed auto
qed simp_all
from unique[OF prems(1) this] show "f'' = f'" .
qed
qed
lemma (in is_cat_equalizer) cat_eq_unique:
assumes "Ξ΅' : E' <β©Cβ©Fβ©.β©eβ©q (π,π,π€,π£) : βββ§2β©C β¦β¦β©CβΞ±β β"
shows
"β!f'. f' : E' β¦βββ E β§ Ξ΅' = Ξ΅ ββ©Nβ©Tβ©Cβ©F ntcf_const (βββ©C πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©L) β f'"
by (rule cat_lim_unique[OF is_cat_equalizerD(1)[OF assms]])
lemma (in is_cat_equalizer) cat_eq_unique':
assumes "Ξ΅' : E' <β©Cβ©Fβ©.β©eβ©q (π,π,π€,π£) : βββ§2β©C β¦β¦β©CβΞ±β β"
shows "β!f'. f' : E' β¦βββ E β§ Ξ΅'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ = Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ ββ©Aβββ f'"
proof-
interpret Ξ΅': is_cat_equalizer Ξ± π π π€ π£ β E' Ξ΅' by (rule assms(1))
show ?thesis by (rule cat_eq_unique_cone[OF Ξ΅'.is_cat_cone_axioms])
qed
lemma (in is_cat_coequalizer) cat_coeq_unique_cocone:
assumes "Ξ΅' :
βββββ β πβ©Pβ©L πβ©Pβ©L π£β©Pβ©L π€β©Pβ©L π π π£ π€ >β©Cβ©Fβ©.β©cβ©oβ©cβ©oβ©nβ©e E' : βββ©C πβ©Pβ©L πβ©Pβ©L π£β©Pβ©L π€β©Pβ©L β¦β¦β©CβΞ±β β"
(is βΉΞ΅' : ?II_II >β©Cβ©Fβ©.β©cβ©oβ©cβ©oβ©nβ©e E' : ?II β¦β¦β©CβΞ±β ββΊ)
shows "β!f'. f' : E β¦βββ E' β§ Ξ΅'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ = f' ββ©Aβββ Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦"
proof-
interpret Ξ΅': is_cat_cocone Ξ± E' ?II β ?II_II Ξ΅' by (rule assms(1))
have [cat_op_simps]:
"f' : E β¦βββ E' β§ Ξ΅'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ = Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ ββ©Aβop_cat ββ f' β·
f' : E β¦βββ E' β§ Ξ΅'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ = f' ββ©Aβββ Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦"
for f'
by (intro iffI conjI; (elim conjE)?)
(
cs_concl
cs_simp: category.op_cat_Comp[symmetric] cat_op_simps cat_cs_simps
cs_intro: cat_cs_intros cat_parallel_cs_intros
)+
show ?thesis
by
(
rule is_cat_equalizer.cat_eq_unique_cone[
OF is_cat_equalizer_op Ξ΅'.is_cat_cone_op[unfolded cat_op_simps],
unfolded cat_op_simps
]
)
qed
lemma (in is_cat_coequalizer) cat_coeq_unique:
assumes "Ξ΅' : (π,π,π€,π£) >β©Cβ©Fβ©.β©cβ©oβ©eβ©q E' : βββ§2β©C β¦β¦β©CβΞ±β β"
shows "β!f'.
f' : E β¦βββ E' β§
Ξ΅' = ntcf_const (βββ©C πβ©Pβ©L πβ©Pβ©L π£β©Pβ©L π€β©Pβ©L) β f' ββ©Nβ©Tβ©Cβ©F Ξ΅"
by (rule cat_colim_unique[OF is_cat_coequalizerD(1)[OF assms]])
lemma (in is_cat_coequalizer) cat_coeq_unique':
assumes "Ξ΅' : (π,π,π€,π£) >β©Cβ©Fβ©.β©cβ©oβ©eβ©q E' : βββ§2β©C β¦β¦β©CβΞ±β β"
shows "β!f'. f' : E β¦βββ E' β§ Ξ΅'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ = f' ββ©Aβββ Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦"
proof-
interpret Ξ΅': is_cat_coequalizer Ξ± π π π€ π£ β E' Ξ΅' by (rule assms(1))
show ?thesis by (rule cat_coeq_unique_cocone[OF Ξ΅'.is_cat_cocone_axioms])
qed
lemma cat_equalizer_2_ex_is_arr_isomorphism:
assumes "Ξ΅ : E <β©Cβ©Fβ©.β©eβ©q (π,π,π€,π£) : βββ§2β©C β¦β¦β©CβΞ±β β"
and "Ξ΅' : E' <β©Cβ©Fβ©.β©eβ©q (π,π,π€,π£) : βββ§2β©C β¦β¦β©CβΞ±β β"
obtains f where "f : E' β¦β©iβ©sβ©oβββ E"
and "Ξ΅' = Ξ΅ ββ©Nβ©Tβ©Cβ©F ntcf_const (βββ©C πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©L) β f"
proof-
interpret Ξ΅: is_cat_equalizer Ξ± π π π€ π£ β E Ξ΅ by (rule assms(1))
interpret Ξ΅': is_cat_equalizer Ξ± π π π€ π£ β E' Ξ΅' by (rule assms(2))
from that show ?thesis
by
(
elim cat_lim_ex_is_arr_isomorphism[
OF Ξ΅.is_cat_limit_axioms Ξ΅'.is_cat_limit_axioms
]
)
qed
lemma cat_equalizer_2_ex_is_arr_isomorphism':
assumes "Ξ΅ : E <β©Cβ©Fβ©.β©eβ©q (π,π,π€,π£) : βββ§2β©C β¦β¦β©CβΞ±β β"
and "Ξ΅' : E' <β©Cβ©Fβ©.β©eβ©q (π,π,π€,π£) : βββ§2β©C β¦β¦β©CβΞ±β β"
obtains f where "f : E' β¦β©iβ©sβ©oβββ E"
and "Ξ΅'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ = Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ ββ©Aβββ f"
and "Ξ΅'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ = Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ ββ©Aβββ f"
proof-
interpret Ξ΅: is_cat_equalizer Ξ± π π π€ π£ β E Ξ΅ by (rule assms(1))
interpret Ξ΅': is_cat_equalizer Ξ± π π π€ π£ β E' Ξ΅' by (rule assms(2))
obtain f where f: "f : E' β¦β©iβ©sβ©oβββ E"
and "j ββ©β βββ©C πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©Lβ¦Objβ¦ βΉ Ξ΅'β¦NTMapβ¦β¦jβ¦ = Ξ΅β¦NTMapβ¦β¦jβ¦ ββ©Aβββ f" for j
by
(
elim cat_lim_ex_is_arr_isomorphism'[
OF Ξ΅.is_cat_limit_axioms Ξ΅'.is_cat_limit_axioms
]
)
then have
"Ξ΅'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ = Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ ββ©Aβββ f"
"Ξ΅'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ = Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ ββ©Aβββ f"
unfolding the_cat_parallel_components by auto
with f show ?thesis using that by simp
qed
lemma cat_coequalizer_2_ex_is_arr_isomorphism:
assumes "Ξ΅ : (π,π,π€,π£) >β©Cβ©Fβ©.β©cβ©oβ©eβ©q E : βββ§2β©C β¦β¦β©CβΞ±β β"
and "Ξ΅' : (π,π,π€,π£) >β©Cβ©Fβ©.β©cβ©oβ©eβ©q E' : βββ§2β©C β¦β¦β©CβΞ±β β"
obtains f where "f : E β¦β©iβ©sβ©oβββ E'"
and "Ξ΅' = ntcf_const (βββ©C πβ©Pβ©L πβ©Pβ©L π£β©Pβ©L π€β©Pβ©L) β f ββ©Nβ©Tβ©Cβ©F Ξ΅"
proof-
interpret Ξ΅: is_cat_coequalizer Ξ± π π π€ π£ β E Ξ΅ by (rule assms(1))
interpret Ξ΅': is_cat_coequalizer Ξ± π π π€ π£ β E' Ξ΅' by (rule assms(2))
from that show ?thesis
by
(
elim cat_colim_ex_is_arr_isomorphism[
OF Ξ΅.is_cat_colimit_axioms Ξ΅'.is_cat_colimit_axioms
]
)
qed
lemma cat_coequalizer_2_ex_is_arr_isomorphism':
assumes "Ξ΅ : (π,π,π€,π£) >β©Cβ©Fβ©.β©cβ©oβ©eβ©q E : βββ§2β©C β¦β¦β©CβΞ±β β"
and "Ξ΅' : (π,π,π€,π£) >β©Cβ©Fβ©.β©cβ©oβ©eβ©q E' : βββ§2β©C β¦β¦β©CβΞ±β β"
obtains f where "f : E β¦β©iβ©sβ©oβββ E'"
and "Ξ΅'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ = f ββ©Aβββ Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦"
and "Ξ΅'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ = f ββ©Aβββ Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦"
proof-
interpret Ξ΅: is_cat_coequalizer Ξ± π π π€ π£ β E Ξ΅ by (rule assms(1))
interpret Ξ΅': is_cat_coequalizer Ξ± π π π€ π£ β E' Ξ΅' by (rule assms(2))
obtain f where f: "f : E β¦β©iβ©sβ©oβββ E'"
and "j ββ©β βββ©C πβ©Pβ©L πβ©Pβ©L π£β©Pβ©L π€β©Pβ©Lβ¦Objβ¦ βΉ Ξ΅'β¦NTMapβ¦β¦jβ¦ = f ββ©Aβββ Ξ΅β¦NTMapβ¦β¦jβ¦" for j
by
(
elim cat_colim_ex_is_arr_isomorphism'[
OF Ξ΅.is_cat_colimit_axioms Ξ΅'.is_cat_colimit_axioms
]
)
then have
"Ξ΅'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ = f ββ©Aβββ Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦"
"Ξ΅'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ = f ββ©Aβββ Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦"
unfolding the_cat_parallel_components by auto
with f show ?thesis using that by simp
qed
subsectionβΉProjection coneβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition ntcf_obj_prod_base :: "V β V β (V β V) β V β (V β V) β V"
where "ntcf_obj_prod_base β I F P f =
[(Ξ»jββ©β:β©C Iβ¦Objβ¦. f j), cf_const (:β©C I) β P, :β: I F β, :β©C I, β]β©β"
textβΉComponents.βΊ
lemma ntcf_obj_prod_base_components:
shows "ntcf_obj_prod_base β I F P fβ¦NTMapβ¦ = (Ξ»jββ©β:β©C Iβ¦Objβ¦. f j)"
and "ntcf_obj_prod_base β I F P fβ¦NTDomβ¦ = cf_const (:β©C I) β P"
and "ntcf_obj_prod_base β I F P fβ¦NTCodβ¦ = :β: I F β"
and "ntcf_obj_prod_base β I F P fβ¦NTDGDomβ¦ = :β©C I"
and "ntcf_obj_prod_base β I F P fβ¦NTDGCodβ¦ = β"
unfolding ntcf_obj_prod_base_def nt_field_simps
by (simp_all add: nat_omega_simps)
subsubsectionβΉNatural transformation mapβΊ
mk_VLambda ntcf_obj_prod_base_components(1)
|vsv ntcf_obj_prod_base_NTMap_vsv[cat_cs_intros]|
|vdomain ntcf_obj_prod_base_NTMap_vdomain[cat_cs_simps]|
|app ntcf_obj_prod_base_NTMap_app[cat_cs_simps]|
subsubsectionβΉProjection natural transformation is a coneβΊ
lemma (in tm_cf_discrete) tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone:
assumes "P ββ©β ββ¦Objβ¦" and "βa. a ββ©β I βΉ f a : P β¦βββ F a"
shows "ntcf_obj_prod_base β I F P f : P <β©Cβ©Fβ©.β©cβ©oβ©nβ©e :β: I F β : :β©C I β¦β¦β©CβΞ±β β"
proof(intro is_cat_coneI is_tm_ntcfI' is_ntcfI')
from assms(2) have [cat_cs_intros]:
"β¦ a ββ©β I; P' = P; Fa = F a β§ βΉ f a : P' β¦βββ Fa" for a P' Fa
by simp
show "vfsequence (ntcf_obj_prod_base β I F P f)"
unfolding ntcf_obj_prod_base_def by auto
show "vcard (ntcf_obj_prod_base β I F P f) = 5β©β"
unfolding ntcf_obj_prod_base_def by (auto simp: nat_omega_simps)
from assms show "cf_const (:β©C I) β P : :β©C I β¦β¦β©CβΞ±β β"
by
(
cs_concl
cs_intro:
cf_discrete_vdomain_vsubset_Vset
cat_discrete_cs_intros
cat_cs_intros
)
show ":β: I F β : :β©C I β¦β¦β©CβΞ±β β"
by (cs_concl cs_intro: cat_discrete_cs_intros)
show "ntcf_obj_prod_base β I F P fβ¦NTMapβ¦β¦aβ¦ :
cf_const (:β©C I) β Pβ¦ObjMapβ¦β¦aβ¦ β¦βββ :β: I F ββ¦ObjMapβ¦β¦aβ¦"
if "a ββ©β :β©C Iβ¦Objβ¦" for a
proof-
from that have "a ββ©β I" unfolding the_cat_discrete_components by simp
from that this show ?thesis
by
(
cs_concl
cs_simp: cat_cs_simps cat_discrete_cs_simps cs_intro: cat_cs_intros
)
qed
show
"ntcf_obj_prod_base β I F P fβ¦NTMapβ¦β¦bβ¦ ββ©Aβββ
cf_const (:β©C I) β Pβ¦ArrMapβ¦β¦gβ¦ =
:β: I F ββ¦ArrMapβ¦β¦gβ¦ ββ©Aβββ ntcf_obj_prod_base β I F P fβ¦NTMapβ¦β¦aβ¦"
if "g : a β¦β:β©C Iβ b" for a b g
proof-
note g = the_cat_discrete_is_arrD[OF that]
from that g(4)[unfolded g(7-9)] g(1)[unfolded g(7-9)] show ?thesis
unfolding g(7-9)
by
(
cs_concl
cs_simp: cat_cs_simps cat_discrete_cs_simps
cs_intro:
cf_discrete_vdomain_vsubset_Vset
cat_cs_intros cat_discrete_cs_intros
)
qed
from assms(1) show "cf_const (:β©C I) β P : :β©C I β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
by
(
cs_concl cs_intro:
cat_cs_intros cat_small_cs_intros cat_small_discrete_cs_intros
)
qed
(
auto simp:
assms
ntcf_obj_prod_base_components
tm_cf_discrete_the_cf_discrete_is_tm_functor
)
lemma (in tm_cf_discrete) tm_cf_discrete_ntcf_obj_prod_base_is_cat_obj_prod:
assumes "P ββ©β ββ¦Objβ¦"
and "βa. a ββ©β I βΉ f a : P β¦βββ F a"
and "βu' r'.
β¦ u' : r' <β©Cβ©Fβ©.β©cβ©oβ©nβ©e :β: I F β : :β©C I β¦β¦β©CβΞ±β β β§ βΉ
β!f'.
f' : r' β¦βββ P β§
u' = ntcf_obj_prod_base β I F P f ββ©Nβ©Tβ©Cβ©F ntcf_const (:β©C I) β f'"
shows "ntcf_obj_prod_base β I F P f : P <β©Cβ©Fβ©.β©β F : I β¦β¦β©CβΞ±β β"
proof
(
intro
is_cat_obj_prodI
is_cat_limitI'
tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone[OF assms(1,2), simplified]
assms(1,3)
)
show "cf_discrete Ξ± I F β"
by (cs_concl cs_intro: cat_small_discrete_cs_intros)
qed
subsectionβΉEqualizer coneβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition ntcf_equalizer_base :: "V β V β V β V β V β V β (V β V) β V"
where "ntcf_equalizer_base β π π π€ π£ E e =
[
(Ξ»xββ©ββββ©C πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©Lβ¦Objβ¦. e x),
cf_const (βββ©C πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©L) β E,
βββββ β πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©L π π π€ π£,
βββ©C πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©L,
β
]β©β"
textβΉComponents.βΊ
lemma ntcf_equalizer_base_components:
shows "ntcf_equalizer_base β π π π€ π£ E eβ¦NTMapβ¦ =
(Ξ»xββ©ββββ©C πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©Lβ¦Objβ¦. e x)"
and [cat_lim_cs_simps]: "ntcf_equalizer_base β π π π€ π£ E eβ¦NTDomβ¦ =
cf_const (βββ©C πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©L) β E"
and [cat_lim_cs_simps]: "ntcf_equalizer_base β π π π€ π£ E eβ¦NTCodβ¦ =
βββββ β πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©L π π π€ π£"
and [cat_lim_cs_simps]:
"ntcf_equalizer_base β π π π€ π£ E eβ¦NTDGDomβ¦ = βββ©C πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©L"
and [cat_lim_cs_simps]:
"ntcf_equalizer_base β π π π€ π£ E eβ¦NTDGCodβ¦ = β"
unfolding ntcf_equalizer_base_def nt_field_simps
by (simp_all add: nat_omega_simps)
subsubsectionβΉNatural transformation mapβΊ
mk_VLambda ntcf_equalizer_base_components(1)
|vsv ntcf_equalizer_base_NTMap_vsv[cat_lim_cs_intros]|
|vdomain ntcf_equalizer_base_NTMap_vdomain[cat_lim_cs_simps]|
|app ntcf_equalizer_base_NTMap_app[cat_lim_cs_simps]|
subsubsectionβΉEqualizer cone is a coneβΊ
lemma (in category) cat_ntcf_equalizer_base_is_cat_cone:
assumes "e πβ©Pβ©L : E β¦βββ π"
and "e πβ©Pβ©L : E β¦βββ π"
and "e πβ©Pβ©L = π€ ββ©Aβββ e πβ©Pβ©L"
and "e πβ©Pβ©L = π£ ββ©Aβββ e πβ©Pβ©L"
and "π€ : π β¦βββ π"
and "π£ : π β¦βββ π"
shows "ntcf_equalizer_base β π π π€ π£ E e :
E <β©Cβ©Fβ©.β©cβ©oβ©nβ©e βββββ β πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©L π π π€ π£ :
βββ©C πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©L β¦β¦β©CβΞ±β β"
proof-
interpret par: cf_parallel Ξ± πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©L π π π€ π£ β
by (intro cf_parallelI cat_parallelI assms(5,6))
(simp_all add: cat_parallel_cs_intros cat_cs_intros)
show ?thesis
proof(intro is_cat_coneI is_tm_ntcfI' is_ntcfI')
show "vfsequence (ntcf_equalizer_base β π π π€ π£ E e)"
unfolding ntcf_equalizer_base_def by auto
show "vcard (ntcf_equalizer_base β π π π€ π£ E e) = 5β©β"
unfolding ntcf_equalizer_base_def by (simp add: nat_omega_simps)
from assms(2) show
"cf_const (βββ©C πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©L) β E : βββ©C πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©L β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_small_cs_intros cat_parallel_cs_intros cat_cs_intros
)
then show "cf_const (βββ©C πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©L) β E : βββ©C πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©L β¦β¦β©CβΞ±β β"
by (cs_concl cs_intro: cat_small_cs_intros)
from assms show
"βββββ β πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©L π π π€ π£ : βββ©C πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©L β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_parallel_cs_intros)
then show "βββββ β πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©L π π π€ π£ : βββ©C πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©L β¦β¦β©CβΞ±β β"
by (cs_concl cs_intro: cat_small_cs_intros)
show
"ntcf_equalizer_base β π π π€ π£ E eβ¦NTMapβ¦β¦iβ¦ :
cf_const (βββ©C πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©L) β Eβ¦ObjMapβ¦β¦iβ¦ β¦βββ
βββββ β πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©L π π π€ π£β¦ObjMapβ¦β¦iβ¦"
if "i ββ©β βββ©C πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©Lβ¦Objβ¦" for i
proof-
from that assms(1,2,5,6) show ?thesis
by (elim the_cat_parallel_ObjE; simp only:)
(
cs_concl
cs_simp: cat_lim_cs_simps cat_cs_simps cat_parallel_cs_simps
cs_intro: cat_cs_intros cat_parallel_cs_intros
)
qed
show
"ntcf_equalizer_base β π π π€ π£ E eβ¦NTMapβ¦β¦b'β¦ ββ©Aβββ
cf_const (βββ©C πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©L) β Eβ¦ArrMapβ¦β¦f'β¦ =
βββββ β πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©L π π π€ π£β¦ArrMapβ¦β¦f'β¦ ββ©Aβββ
ntcf_equalizer_base β π π π€ π£ E eβ¦NTMapβ¦β¦a'β¦"
if "f' : a' β¦ββββ©C πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©Lβ b'" for a' b' f'
using that assms(1,2,5,6)
by (elim par.the_cat_parallel_is_arrE; simp only:)
(
cs_concl
cs_simp:
cat_cs_simps
cat_lim_cs_simps
cat_parallel_cs_simps
assms(3,4)[symmetric]
cs_intro: cat_parallel_cs_intros
)+
qed
(
use assms(2) in
βΉ
cs_concl
cs_intro: cat_lim_cs_intros cat_cs_intros
cs_simp: cat_lim_cs_simps
βΊ
)+
qed
subsectionβΉLimits by products and equalizersβΊ
lemma cat_limit_of_cat_prod_obj_and_cat_equalizer:
assumes "π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
and "βπ π π€ π£. β¦ π£ : π β¦βββ π; π€ : π β¦βββ π β§ βΉ
βE Ξ΅. Ξ΅ : E <β©Cβ©Fβ©.β©eβ©q (π,π,π€,π£) : βββ§2β©C β¦β¦β©CβΞ±β β"
and "βA. tm_cf_discrete Ξ± (πβ¦Objβ¦) A β βΉ
βP Ο. Ο : P <β©Cβ©Fβ©.β©β A : πβ¦Objβ¦ β¦β¦β©CβΞ±β β"
and "βA. tm_cf_discrete Ξ± (πβ¦Arrβ¦) A β βΉ
βP Ο. Ο : P <β©Cβ©Fβ©.β©β A : πβ¦Arrβ¦ β¦β¦β©CβΞ±β β"
obtains r u where "u : r <β©Cβ©Fβ©.β©lβ©iβ©m π : π β¦β¦β©CβΞ±β β"
proof-
let ?L =βΉΞ»u. πβ¦ObjMapβ¦β¦πβ¦Codβ¦β¦uβ¦β¦βΊ and ?R =βΉΞ»i. πβ¦ObjMapβ¦β¦iβ¦βΊ
interpret π: is_tm_functor Ξ± π β π by (rule assms(1))
have "?R j ββ©β ββ¦Objβ¦" if "j ββ©β πβ¦Objβ¦" for j
by (cs_concl cs_intro: cat_cs_intros that)
have "tm_cf_discrete Ξ± (πβ¦Objβ¦) ?R β"
proof(intro tm_cf_discreteI)
show "πβ¦ObjMapβ¦β¦iβ¦ ββ©β ββ¦Objβ¦" if "i ββ©β πβ¦Objβ¦" for i
by (cs_concl cs_intro: cat_cs_intros that)
show "VLambda (πβ¦Objβ¦) ?R ββ©β Vset Ξ±"
proof(rule vbrelation.vbrelation_Limit_in_VsetI)
show "ββ©β (VLambda (πβ¦Objβ¦) ?R) ββ©β Vset Ξ±"
proof-
have "ββ©β (VLambda (πβ¦Objβ¦) ?R) ββ©β ββ©β (πβ¦ObjMapβ¦)"
by (auto simp: π.cf_ObjMap_vdomain)
moreover have "ββ©β (πβ¦ObjMapβ¦) ββ©β Vset Ξ±"
by (force intro: vrange_in_VsetI π.tm_cf_ObjMap_in_Vset)
ultimately show ?thesis by auto
qed
qed (auto simp: cat_small_cs_intros)
show "(Ξ»iββ©βπβ¦Objβ¦. ββ¦CIdβ¦β¦πβ¦ObjMapβ¦β¦iβ¦β¦) ββ©β Vset Ξ±"
proof(rule vbrelation.vbrelation_Limit_in_VsetI)
show "ββ©β (Ξ»iββ©βπβ¦Objβ¦. ββ¦CIdβ¦β¦πβ¦ObjMapβ¦β¦iβ¦β¦) ββ©β Vset Ξ±"
proof-
have "ββ©β (Ξ»iββ©βπβ¦Objβ¦. ββ¦CIdβ¦β¦πβ¦ObjMapβ¦β¦iβ¦β¦) ββ©β ββ©β (πβ¦ArrMapβ¦)"
proof(rule vrange_VLambda_vsubset)
fix x assume x: "x ββ©β πβ¦Objβ¦"
then have "πβ¦CIdβ¦β¦xβ¦ ββ©β πβ©β (πβ¦ArrMapβ¦)"
by (auto intro: cat_cs_intros simp: cat_cs_simps)
moreover from x have "ββ¦CIdβ¦β¦πβ¦ObjMapβ¦β¦xβ¦β¦ = πβ¦ArrMapβ¦β¦πβ¦CIdβ¦β¦xβ¦β¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
ultimately show "ββ¦CIdβ¦β¦πβ¦ObjMapβ¦β¦xβ¦β¦ ββ©β ββ©β (πβ¦ArrMapβ¦)"
by (simp add: π.ArrMap.vsv_vimageI2)
qed
moreover have "ββ©β (πβ¦ArrMapβ¦) ββ©β Vset Ξ±"
by (force intro: vrange_in_VsetI π.tm_cf_ArrMap_in_Vset)
ultimately show ?thesis by auto
qed
qed (auto simp: cat_small_cs_intros)
qed (auto intro: cat_cs_intros)
from assms(3)[where A=βΉ?RβΊ, OF this] obtain Pβ©O Οβ©O
where Οβ©O: "Οβ©O : Pβ©O <β©Cβ©Fβ©.β©β ?R : πβ¦Objβ¦ β¦β¦β©CβΞ±β β"
by clarsimp
interpret Οβ©O: is_cat_obj_prod Ξ± βΉπβ¦Objβ¦βΊ ?R β Pβ©O Οβ©O by (rule Οβ©O)
have Pβ©O: "Pβ©O ββ©β ββ¦Objβ¦" by (intro Οβ©O.cat_cone_obj)
have "?L u ββ©β ββ¦Objβ¦" if "u ββ©β πβ¦Arrβ¦" for u
proof-
from that obtain a b where "u : a β¦βπβ b" by auto
then show ?thesis by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
have tm_cf_discrete: "tm_cf_discrete Ξ± (πβ¦Arrβ¦) ?L β"
proof(intro tm_cf_discreteI)
show "πβ¦ObjMapβ¦β¦πβ¦Codβ¦β¦fβ¦β¦ ββ©β ββ¦Objβ¦" if "f ββ©β πβ¦Arrβ¦" for f
proof-
from that obtain a b where "f : a β¦βπβ b" by auto
then show ?thesis
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
show "(Ξ»uββ©βπβ¦Arrβ¦. πβ¦ObjMapβ¦β¦πβ¦Codβ¦β¦uβ¦β¦) ββ©β Vset Ξ±"
proof(rule vbrelation.vbrelation_Limit_in_VsetI)
show "ββ©β (Ξ»uββ©βπβ¦Arrβ¦. ?L u) ββ©β Vset Ξ±"
proof-
have "ββ©β (Ξ»uββ©βπβ¦Arrβ¦. ?L u) ββ©β ββ©β (πβ¦ObjMapβ¦)"
proof(rule vrange_VLambda_vsubset)
fix f assume "f ββ©β πβ¦Arrβ¦"
then obtain a b where "f : a β¦βπβ b" by auto
then show "πβ¦ObjMapβ¦β¦πβ¦Codβ¦β¦fβ¦β¦ ββ©β ββ©β (πβ¦ObjMapβ¦)"
by
(
cs_concl
cs_simp: cat_cs_simps cs_intro: V_cs_intros cat_cs_intros
)
qed
moreover have "ββ©β (πβ¦ObjMapβ¦) ββ©β Vset Ξ±"
by (auto intro: vrange_in_VsetI π.tm_cf_ObjMap_in_Vset)
ultimately show ?thesis by auto
qed
qed (auto simp: cat_small_cs_intros)
show "(Ξ»iββ©βπβ¦Arrβ¦. ββ¦CIdβ¦β¦πβ¦ObjMapβ¦β¦πβ¦Codβ¦β¦iβ¦β¦β¦) ββ©β Vset Ξ±"
proof(rule vbrelation.vbrelation_Limit_in_VsetI)
show "ββ©β (Ξ»iββ©βπβ¦Arrβ¦. ββ¦CIdβ¦β¦πβ¦ObjMapβ¦β¦πβ¦Codβ¦β¦iβ¦β¦β¦) ββ©β Vset Ξ±"
proof-
have "ββ©β (Ξ»iββ©βπβ¦Arrβ¦. ββ¦CIdβ¦β¦πβ¦ObjMapβ¦β¦πβ¦Codβ¦β¦iβ¦β¦β¦) ββ©β ββ©β (πβ¦ArrMapβ¦)"
proof(rule vrange_VLambda_vsubset)
fix f assume "f ββ©β πβ¦Arrβ¦"
then obtain a b where f: "f : a β¦βπβ b" by auto
then have "πβ¦CIdβ¦β¦bβ¦ ββ©β πβ©β (πβ¦ArrMapβ¦)"
by (auto intro: cat_cs_intros simp: cat_cs_simps)
moreover from f have
"ββ¦CIdβ¦β¦πβ¦ObjMapβ¦β¦πβ¦Codβ¦β¦fβ¦β¦β¦ = πβ¦ArrMapβ¦β¦πβ¦CIdβ¦β¦bβ¦β¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
ultimately show "ββ¦CIdβ¦β¦πβ¦ObjMapβ¦β¦πβ¦Codβ¦β¦fβ¦β¦β¦ ββ©β ββ©β (πβ¦ArrMapβ¦)"
by (simp add: π.ArrMap.vsv_vimageI2)
qed
moreover have "ββ©β (πβ¦ArrMapβ¦) ββ©β Vset Ξ±"
by (force intro: vrange_in_VsetI π.tm_cf_ArrMap_in_Vset)
ultimately show ?thesis by auto
qed
qed (auto simp: cat_small_cs_intros)
qed (auto intro: cat_cs_intros)
from assms(4)[where A=βΉ?LβΊ, OF this, simplified] obtain Pβ©A Οβ©A
where Οβ©A: "Οβ©A : Pβ©A <β©Cβ©Fβ©.β©β ?L : πβ¦Arrβ¦ β¦β¦β©CβΞ±β β"
by auto
interpret Οβ©A: is_cat_obj_prod Ξ± βΉπβ¦Arrβ¦βΊ ?L β Pβ©A Οβ©A by (rule Οβ©A)
let ?F = βΉΞ»u. πβ¦ObjMapβ¦β¦πβ¦Codβ¦β¦uβ¦β¦βΊ and ?f = βΉΞ»u. Οβ©Oβ¦NTMapβ¦β¦πβ¦Codβ¦β¦uβ¦β¦βΊ
let ?Οβ©O' = βΉntcf_obj_prod_base β (:β©C (πβ¦Arrβ¦)β¦Objβ¦) ?F Pβ©O ?fβΊ
have Οβ©O': "?Οβ©O' :
Pβ©O <β©Cβ©Fβ©.β©cβ©oβ©nβ©e :β: (πβ¦Arrβ¦) (Ξ»u. πβ¦ObjMapβ¦β¦πβ¦Codβ¦β¦uβ¦β¦) β :
:β©C (πβ¦Arrβ¦) β¦β¦β©CβΞ±β β"
unfolding the_cat_discrete_components(1)
proof
(
intro
tm_cf_discrete.tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone
tm_cf_discrete
)
fix f assume "f ββ©β πβ¦Arrβ¦"
then obtain a b where "f : a β¦βπβ b" by auto
then show "Οβ©Oβ¦NTMapβ¦β¦πβ¦Codβ¦β¦fβ¦β¦ : Pβ©O β¦βββ πβ¦ObjMapβ¦β¦πβ¦Codβ¦β¦fβ¦β¦"
by
(
cs_concl
cs_simp:
the_cat_discrete_components(1) cat_discrete_cs_simps cat_cs_simps
cs_intro: cat_cs_intros
)
qed (intro Pβ©O)
from Οβ©A.cat_obj_prod_unique_cone'[OF Οβ©O'] obtain f'
where f': "f' : Pβ©O β¦βββ Pβ©A"
and Οβ©O'_NTMap_app:
"βj. j ββ©β πβ¦Arrβ¦ βΉ ?Οβ©O'β¦NTMapβ¦β¦jβ¦ = Οβ©Aβ¦NTMapβ¦β¦jβ¦ ββ©Aβββ f'"
and unique_f':
"β¦
f'' : Pβ©O β¦βββ Pβ©A;
βj. j ββ©β πβ¦Arrβ¦ βΉ ?Οβ©O'β¦NTMapβ¦β¦jβ¦ = Οβ©Aβ¦NTMapβ¦β¦jβ¦ ββ©Aβββ f''
β§ βΉ f'' = f'"
for f''
by metis
have Οβ©O_NTMap_app_Cod:
"Οβ©Oβ¦NTMapβ¦β¦bβ¦ = Οβ©Aβ¦NTMapβ¦β¦fβ¦ ββ©Aβββ f'" if "f : a β¦βπβ b" for f a b
proof-
from that have "f ββ©β πβ¦Arrβ¦" by auto
from Οβ©O'_NTMap_app[OF this] that show ?thesis
by
(
cs_prems
cs_simp: cat_cs_simps the_cat_discrete_components(1)
cs_intro: cat_cs_intros
)
qed
from this[symmetric] have Οβ©A_NTMap_Comp_app:
"Οβ©Aβ¦NTMapβ¦β¦fβ¦ ββ©Aβββ (f' ββ©Aβββ q) = Οβ©Oβ¦NTMapβ¦β¦bβ¦ ββ©Aβββ q"
if "f : a β¦βπβ b" and "q : c β¦βββ Pβ©O" for q f a b c
using that f'
by (intro π.HomCod.cat_assoc_helper)
(
cs_concl
cs_simp:
cat_cs_simps cat_discrete_cs_simps the_cat_discrete_components(1)
cs_intro: cat_cs_intros
)+
let ?g = βΉΞ»u. πβ¦ArrMapβ¦β¦uβ¦ ββ©Aβββ Οβ©Oβ¦NTMapβ¦β¦πβ¦Domβ¦β¦uβ¦β¦βΊ
let ?Οβ©O'' = βΉntcf_obj_prod_base β (:β©C (πβ¦Arrβ¦)β¦Objβ¦) ?F Pβ©O ?gβΊ
have Οβ©O'': "?Οβ©O'' : Pβ©O <β©Cβ©Fβ©.β©cβ©oβ©nβ©e :β: (πβ¦Arrβ¦) ?L β : :β©C (πβ¦Arrβ¦) β¦β¦β©CβΞ±β β"
unfolding the_cat_discrete_components(1)
proof
(
intro
tm_cf_discrete.tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone
tm_cf_discrete
)
show "πβ¦ArrMapβ¦β¦fβ¦ ββ©Aβββ Οβ©Oβ¦NTMapβ¦β¦πβ¦Domβ¦β¦fβ¦β¦ : Pβ©O β¦βββ πβ¦ObjMapβ¦β¦πβ¦Codβ¦β¦fβ¦β¦"
if "f ββ©β πβ¦Arrβ¦" for f
proof-
from that obtain a b where "f : a β¦βπβ b" by auto
then show ?thesis
by
(
cs_concl
cs_simp:
cat_cs_simps cat_discrete_cs_simps
the_cat_discrete_components(1)
cs_intro: cat_cs_intros
)
qed
qed (intro Pβ©O)
from Οβ©A.cat_obj_prod_unique_cone'[OF Οβ©O''] obtain g'
where g': "g' : Pβ©O β¦βββ Pβ©A"
and Οβ©O''_NTMap_app:
"βj. j ββ©β πβ¦Arrβ¦ βΉ ?Οβ©O''β¦NTMapβ¦β¦jβ¦ = Οβ©Aβ¦NTMapβ¦β¦jβ¦ ββ©Aβββ g'"
and unique_g':
"β¦
g'' : Pβ©O β¦βββ Pβ©A;
βj. j ββ©β πβ¦Arrβ¦ βΉ ?Οβ©O''β¦NTMapβ¦β¦jβ¦ = Οβ©Aβ¦NTMapβ¦β¦jβ¦ ββ©Aβββ g''
β§ βΉ g'' = g'"
for g''
by (metis (lifting))
have "πβ¦ArrMapβ¦β¦fβ¦ ββ©Aβββ Οβ©Oβ¦NTMapβ¦β¦aβ¦ = Οβ©Aβ¦NTMapβ¦β¦fβ¦ ββ©Aβββ g'"
if "f : a β¦βπβ b" for f a b
proof-
from that have "f ββ©β πβ¦Arrβ¦" by auto
from Οβ©O''_NTMap_app[OF this] that show ?thesis
by
(
cs_prems
cs_simp: cat_cs_simps the_cat_discrete_components(1)
cs_intro: cat_cs_intros
)
qed
then have Οβ©O_NTMap_app_Dom:
"πβ¦ArrMapβ¦β¦fβ¦ ββ©Aβββ (Οβ©Oβ¦NTMapβ¦β¦aβ¦ ββ©Aβββ q) =
(Οβ©Aβ¦NTMapβ¦β¦fβ¦ ββ©Aβββ g') ββ©Aβββ q"
if "f : a β¦βπβ b" and "q : c β¦βββ Pβ©O" for q f a b c
using that g'
by (intro π.HomCod.cat_assoc_helper)
(
cs_concl
cs_simp:
cat_cs_simps cat_discrete_cs_simps the_cat_discrete_components(1)
cs_intro: cat_cs_intros
)
from assms(2)[OF f' g'] obtain E Ξ΅ where Ξ΅:
"Ξ΅ : E <β©Cβ©Fβ©.β©eβ©q (Pβ©O,Pβ©A,g',f') : βββ§2β©C β¦β¦β©CβΞ±β β"
by clarsimp
interpret Ξ΅: is_cat_equalizer Ξ± Pβ©O Pβ©A g' f' β E Ξ΅ by (rule Ξ΅)
define ΞΌ where "ΞΌ =
[(Ξ»iββ©βπβ¦Objβ¦. Οβ©Oβ¦NTMapβ¦β¦iβ¦ ββ©Aβββ Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦), cf_const π β E, π, π, β]β©β"
have ΞΌ_components:
"ΞΌβ¦NTMapβ¦ = (Ξ»iββ©βπβ¦Objβ¦. Οβ©Oβ¦NTMapβ¦β¦iβ¦ ββ©Aβββ Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦)"
"ΞΌβ¦NTDomβ¦ = cf_const π β E"
"ΞΌβ¦NTCodβ¦ = π"
"ΞΌβ¦NTDGDomβ¦ = π"
"ΞΌβ¦NTDGCodβ¦ = β"
unfolding ΞΌ_def nt_field_simps by (simp_all add: nat_omega_simps)
have [cat_cs_simps]:
"ΞΌβ¦NTMapβ¦β¦iβ¦ = Οβ©Oβ¦NTMapβ¦β¦iβ¦ ββ©Aβββ Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦" if "i ββ©β πβ¦Objβ¦"
for i
using that unfolding ΞΌ_components by simp
have "ΞΌ : E <β©Cβ©Fβ©.β©lβ©iβ©m π : π β¦β¦β©CβΞ±β β"
proof(intro is_cat_limitI')
show ΞΌ: "ΞΌ : E <β©Cβ©Fβ©.β©cβ©oβ©nβ©e π : π β¦β¦β©CβΞ±β β"
proof(intro is_cat_coneI is_tm_ntcfI' is_ntcfI')
show "vfsequence ΞΌ" unfolding ΞΌ_def by simp
show "vcard ΞΌ = 5β©β" unfolding ΞΌ_def by (simp add: nat_omega_simps)
show "cf_const π β E : π β¦β¦β©CβΞ±β β"
by (cs_concl cs_intro: cat_cs_intros cat_lim_cs_intros)
show "π : π β¦β¦β©CβΞ±β β" by (cs_concl cs_intro: cat_cs_intros)
show "ΞΌβ¦NTMapβ¦β¦aβ¦ : cf_const π β Eβ¦ObjMapβ¦β¦aβ¦ β¦βββ πβ¦ObjMapβ¦β¦aβ¦"
if "a ββ©β πβ¦Objβ¦" for a
using that
by
(
cs_concl
cs_simp:
cat_cs_simps
cat_discrete_cs_simps
cat_parallel_cs_simps
the_cat_discrete_components(1)
cs_intro: cat_cs_intros cat_lim_cs_intros cat_parallel_cs_intros
)
show
"ΞΌβ¦NTMapβ¦β¦bβ¦ ββ©Aβββ cf_const π β Eβ¦ArrMapβ¦β¦fβ¦ =
πβ¦ArrMapβ¦β¦fβ¦ ββ©Aβββ ΞΌβ¦NTMapβ¦β¦aβ¦"
if "f : a β¦βπβ b" for a b f
using that Ξ΅ g' f'
by
(
cs_concl
cs_simp:
cat_parallel_cs_simps
cat_cs_simps
the_cat_discrete_components(1)
Οβ©O_NTMap_app_Cod
Οβ©O_NTMap_app_Dom
Ξ΅.cat_eq_Comp_eq(1)
cs_intro: cat_lim_cs_intros cat_cs_intros cat_parallel_cs_intros
)
show "cf_const π β E : π β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
by
(
cs_concl cs_simp: cs_intro:
cat_lim_cs_intros cat_cs_intros cat_small_cs_intros
)
show "π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
by (cs_concl cs_simp: cs_intro: cat_small_cs_intros)
qed (auto simp: ΞΌ_components cat_lim_cs_intros)
interpret ΞΌ: is_cat_cone Ξ± E π β π ΞΌ by (rule ΞΌ)
show "β!f'. f' : r' β¦βββ E β§ u' = ΞΌ ββ©Nβ©Tβ©Cβ©F ntcf_const π β f'"
if "u' : r' <β©Cβ©Fβ©.β©cβ©oβ©nβ©e π : π β¦β¦β©CβΞ±β β" for u' r'
proof-
interpret u': is_cat_cone Ξ± r' π β π u' by (rule that)
let ?u' = βΉΞ»j. u'β¦NTMapβ¦β¦jβ¦βΊ
let ?Ο' = βΉntcf_obj_prod_base β (πβ¦Objβ¦) ?R r' ?u'βΊ
have Ο'_NTMap_app: "?Ο'β¦NTMapβ¦β¦jβ¦ = u'β¦NTMapβ¦β¦jβ¦" if "j ββ©β πβ¦Objβ¦" for j
using that
unfolding ntcf_obj_prod_base_components the_cat_discrete_components
by auto
have Ο': "?Ο' : r' <β©Cβ©Fβ©.β©cβ©oβ©nβ©e :β: (πβ¦Objβ¦) ?R β : :β©C (πβ¦Objβ¦) β¦β¦β©CβΞ±β β"
unfolding the_cat_discrete_components(1)
proof(intro tm_cf_discrete.tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone)
show "tm_cf_discrete Ξ± (πβ¦Objβ¦) ?R β"
proof(intro tm_cf_discreteI)
show "πβ¦ObjMapβ¦β¦iβ¦ ββ©β ββ¦Objβ¦" if "i ββ©β πβ¦Objβ¦" for i
using that
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
(
auto intro:
cat_cs_intros
Pβ©O
Οβ©O.NTCod.tm_cf_ArrMap_in_Vset[unfolded the_cf_discrete_components]
Οβ©O.NTCod.tm_cf_ObjMap_in_Vset[unfolded the_cf_discrete_components]
)
show "u'β¦NTMapβ¦β¦jβ¦ : r' β¦βββ πβ¦ObjMapβ¦β¦jβ¦" if "j ββ©β πβ¦Objβ¦" for j
using that by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed (auto simp: cat_lim_cs_intros)
from Οβ©O.cat_obj_prod_unique_cone'[OF this] obtain h'
where h': "h' : r' β¦βββ Pβ©O"
and Ο'_NTMap_app':
"βj. j ββ©β (πβ¦Objβ¦) βΉ ?Ο'β¦NTMapβ¦β¦jβ¦ = Οβ©Oβ¦NTMapβ¦β¦jβ¦ ββ©Aβββ h'"
and unique_h': "βh''.
β¦
h'' : r' β¦βββ Pβ©O;
βj. j ββ©β (πβ¦Objβ¦) βΉ ?Ο'β¦NTMapβ¦β¦jβ¦ = Οβ©Oβ¦NTMapβ¦β¦jβ¦ ββ©Aβββ h''
β§ βΉ h'' = h'"
by metis
interpret Ο':
is_cat_cone Ξ± r' βΉ:β©C (πβ¦Objβ¦)βΊ β βΉ:β: (πβ¦Objβ¦) (app (πβ¦ObjMapβ¦)) ββΊ ?Ο'
by (rule Ο')
let ?u'' = βΉΞ»u. u'β¦NTMapβ¦β¦πβ¦Codβ¦β¦uβ¦β¦βΊ
let ?Ο'' = βΉntcf_obj_prod_base β (πβ¦Arrβ¦) ?L r' ?u''βΊ
have Ο''_NTMap_app: "?Ο''β¦NTMapβ¦β¦fβ¦ = u'β¦NTMapβ¦β¦bβ¦"
if "f : a β¦βπβ b" for f a b
using that
unfolding ntcf_obj_prod_base_components the_cat_discrete_components
by (cs_concl cs_simp: V_cs_simps cat_cs_simps cs_intro: cat_cs_intros)
have Ο'': "?Ο'' : r' <β©Cβ©Fβ©.β©cβ©oβ©nβ©e :β: (πβ¦Arrβ¦) ?L β : :β©C (πβ¦Arrβ¦) β¦β¦β©CβΞ±β β"
unfolding the_cat_discrete_components(1)
proof
(
intro
tm_cf_discrete.tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone
tm_cf_discrete
)
fix f assume "f ββ©β πβ¦Arrβ¦"
then obtain a b where "f : a β¦βπβ b" by auto
then show "u'β¦NTMapβ¦β¦πβ¦Codβ¦β¦fβ¦β¦ : r' β¦βββ πβ¦ObjMapβ¦β¦πβ¦Codβ¦β¦fβ¦β¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed (simp add: cat_lim_cs_intros)
from Οβ©A.cat_obj_prod_unique_cone'[OF this] obtain h''
where h'': "h'' : r' β¦βββ Pβ©A"
and Ο''_NTMap_app':
"βj. j ββ©β πβ¦Arrβ¦ βΉ ?Ο''β¦NTMapβ¦β¦jβ¦ = Οβ©Aβ¦NTMapβ¦β¦jβ¦ ββ©Aβββ h''"
and unique_h'': "βh'''.
β¦
h''' : r' β¦βββ Pβ©A;
βj. j ββ©β πβ¦Arrβ¦ βΉ ?Ο''β¦NTMapβ¦β¦jβ¦ = Οβ©Aβ¦NTMapβ¦β¦jβ¦ ββ©Aβββ h'''
β§ βΉ h''' = h''"
by metis
interpret Ο'': is_cat_cone Ξ± r' βΉ:β©C (πβ¦Arrβ¦)βΊ β βΉ:β: (πβ¦Arrβ¦) ?L ββΊ ?Ο''
by (rule Ο'')
have g'h'_f'h': "g' ββ©Aβββ h' = f' ββ©Aβββ h'"
proof-
from g' h' have g'h': "g' ββ©Aβββ h' : r' β¦βββ Pβ©A"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from f' h' have f'h': "f' ββ©Aβββ h' : r' β¦βββ Pβ©A"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
have "?Ο''β¦NTMapβ¦β¦fβ¦ = Οβ©Aβ¦NTMapβ¦β¦fβ¦ ββ©Aβββ (g' ββ©Aβββ h')"
if "f ββ©β πβ¦Arrβ¦" for f
proof-
from that obtain a b where f: "f : a β¦βπβ b" by auto
then have "?Ο''β¦NTMapβ¦β¦fβ¦ = u'β¦NTMapβ¦β¦bβ¦"
by (cs_concl cs_simp: Ο''_NTMap_app cat_cs_simps)
also from f have "β¦ = πβ¦ArrMapβ¦β¦fβ¦ ββ©Aβββ ?Ο'β¦NTMapβ¦β¦aβ¦"
by
(
cs_concl
cs_simp: Ο'_NTMap_app cat_lim_cs_simps cs_intro: cat_cs_intros
)
also from f g' h' have "β¦ = Οβ©Aβ¦NTMapβ¦β¦fβ¦ ββ©Aβββ (g' ββ©Aβββ h')"
by
(
cs_concl
cs_simp:
cat_cs_simps
cat_discrete_cs_simps
the_cat_discrete_components(1)
Ο'_NTMap_app'
Οβ©O_NTMap_app_Dom
cs_intro: cat_cs_intros
)
finally show ?thesis by simp
qed
from unique_h''[OF g'h' this, simplified] have g'h'_h'':
"g' ββ©Aβββ h' = h''".
have "?Ο''β¦NTMapβ¦β¦fβ¦ = Οβ©Aβ¦NTMapβ¦β¦fβ¦ ββ©Aβββ (f' ββ©Aβββ h')"
if "f ββ©β πβ¦Arrβ¦" for f
proof-
from that obtain a b where f: "f : a β¦βπβ b" by auto
then have "?Ο''β¦NTMapβ¦β¦fβ¦ = u'β¦NTMapβ¦β¦bβ¦"
by (cs_concl cs_simp: Ο''_NTMap_app cat_cs_simps)
also from f have "β¦ = ?Ο'β¦NTMapβ¦β¦bβ¦"
by (cs_concl cs_simp: Ο'_NTMap_app cs_intro: cat_cs_intros)
also from f have "β¦ = Οβ©Oβ¦NTMapβ¦β¦bβ¦ ββ©Aβββ h'"
by (cs_concl cs_simp: Ο'_NTMap_app' cs_intro: cat_cs_intros)
also from f g' h' have "β¦ = (Οβ©Aβ¦NTMapβ¦β¦fβ¦ ββ©Aβββ f') ββ©Aβββ h'"
by (cs_concl cs_simp: Οβ©O_NTMap_app_Cod cs_intro: cat_cs_intros)
also from that f' h' have "β¦ = Οβ©Aβ¦NTMapβ¦β¦fβ¦ ββ©Aβββ (f' ββ©Aβββ h')"
by
(
cs_concl
cs_simp: cat_cs_simps the_cat_discrete_components(1)
cs_intro: cat_cs_intros
)
finally show ?thesis by simp
qed
from unique_h''[OF f'h' this, simplified] have f'h'_h'':
"f' ββ©Aβββ h' = h''".
from g'h'_h'' f'h'_h'' show ?thesis by simp
qed
let ?II = βΉβββ©C πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©LβΊ
and ?II_II = βΉβββββ β πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©L Pβ©O Pβ©A g' f'βΊ
define Ξ΅' where "Ξ΅' =
[
(Ξ»fββ©β?IIβ¦Objβ¦. (f = πβ©Pβ©L ? h' : (f' ββ©Aβββ h'))),
cf_const ?II β r',
?II_II,
?II,
β
]β©β"
have Ξ΅'_components:
"Ξ΅'β¦NTMapβ¦ = (Ξ»fββ©β?IIβ¦Objβ¦. (f = πβ©Pβ©L ? h' : (f' ββ©Aβββ h')))"
"Ξ΅'β¦NTDomβ¦ = cf_const ?II β r'"
"Ξ΅'β¦NTCodβ¦ = ?II_II"
"Ξ΅'β¦NTDGDomβ¦ = ?II"
"Ξ΅'β¦NTDGCodβ¦ = β"
unfolding Ξ΅'_def nt_field_simps by (simp_all add: nat_omega_simps)
have Ξ΅'_NTMap_app_I2: "Ξ΅'β¦NTMapβ¦β¦xβ¦ = h'" if "x = πβ©Pβ©L" for x
proof-
have "x ββ©β ?IIβ¦Objβ¦"
unfolding that by (cs_concl cs_intro: cat_parallel_cs_intros)
then show ?thesis unfolding Ξ΅'_components that by simp
qed
have Ξ΅'_NTMap_app_sI2: "Ξ΅'β¦NTMapβ¦β¦xβ¦ = f' ββ©Aβββ h'" if "x = πβ©Pβ©L" for x
proof-
have "x ββ©β ?IIβ¦Objβ¦"
unfolding that by (cs_concl cs_intro: cat_parallel_cs_intros)
with Ξ΅.cat_parallel_ππ show ?thesis
unfolding Ξ΅'_components by (cs_concl cs_simp: V_cs_simps that)
qed
interpret par: cf_parallel Ξ± πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©L Pβ©O Pβ©A g' f' β
by (intro cf_parallelI cat_parallelI)
(
simp_all add:
cat_cs_intros cat_parallel_cs_intros cat_PL_ineq[symmetric]
)
have "Ξ΅' : r' <β©Cβ©Fβ©.β©cβ©oβ©nβ©e ?II_II : ?II β¦β¦β©CβΞ±β β"
proof(intro is_cat_coneI is_tm_ntcfI' is_ntcfI')
show "vfsequence Ξ΅'" unfolding Ξ΅'_def by auto
show "vcard Ξ΅' = 5β©β" unfolding Ξ΅'_def by (simp add: nat_omega_simps)
from h' show "cf_const (?II) β r' : ?II β¦β¦β©CβΞ±β β"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "?II_II : ?II β¦β¦β©CβΞ±β β"
by (cs_concl cs_simp: cat_parallel_cs_simps cs_intro: cat_cs_intros)
from h' show "Ξ΅'β¦NTMapβ¦β¦aβ¦ :
cf_const ?II β r'β¦ObjMapβ¦β¦aβ¦ β¦βββ ?II_IIβ¦ObjMapβ¦β¦aβ¦"
if "a ββ©β ?IIβ¦Objβ¦" for a
using that
by (elim the_cat_parallel_ObjE; simp only:)
(
cs_concl
cs_simp:
Ξ΅'_NTMap_app_I2 Ξ΅'_NTMap_app_sI2
cat_cs_simps cat_parallel_cs_simps
cs_intro: cat_cs_intros cat_parallel_cs_intros
)
from h' f' g'h'_f'h' show
"Ξ΅'β¦NTMapβ¦β¦bβ¦ ββ©Aβββ cf_const ?II β r'β¦ArrMapβ¦β¦fβ¦ =
?II_IIβ¦ArrMapβ¦β¦fβ¦ ββ©Aβββ Ξ΅'β¦NTMapβ¦β¦aβ¦"
if "f : a β¦β?IIβ b" for a b f
using that
by (elim Ξ΅.the_cat_parallel_is_arrE; simp only:)
(
cs_concl
cs_intro: cat_cs_intros cat_parallel_cs_intros
cs_simp:
cat_cs_simps
cat_parallel_cs_simps
Ξ΅'_NTMap_app_I2
Ξ΅'_NTMap_app_sI2
)+
qed
(
simp add: Ξ΅'_components |
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_lim_cs_intros cat_cs_intros cat_small_cs_intros
)+
from Ξ΅.cat_eq_unique_cone[OF this] obtain t'
where t': "t' : r' β¦βββ E"
and Ξ΅'_NTMap_app: "Ξ΅'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ = Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ ββ©Aβββ t'"
and unique_t':
"β¦ t'' : r' β¦βββ E; Ξ΅'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ = Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ ββ©Aβββ t''β§ βΉ
t'' = t'"
for t''
by metis
show "β!f'. f' : r' β¦βββ E β§ u' = ΞΌ ββ©Nβ©Tβ©Cβ©F ntcf_const π β f'"
proof(intro ex1I conjI; (elim conjE)?, (rule t')?)
show [symmetric, cat_cs_simps]: "u' = ΞΌ ββ©Nβ©Tβ©Cβ©F ntcf_const π β t'"
proof(rule ntcf_eqI[OF u'.is_ntcf_axioms])
from t' show
"ΞΌ ββ©Nβ©Tβ©Cβ©F ntcf_const π β t' : cf_const π β r' β¦β©Cβ©F π : π β¦β¦β©CβΞ±β β"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "u'β¦NTMapβ¦ = (ΞΌ ββ©Nβ©Tβ©Cβ©F ntcf_const π β t')β¦NTMapβ¦"
proof(rule vsv_eqI)
show "vsv ((ΞΌ ββ©Nβ©Tβ©Cβ©F ntcf_const π β t')β¦NTMapβ¦)"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from t' show
"πβ©β (u'β¦NTMapβ¦) = πβ©β ((ΞΌ ββ©Nβ©Tβ©Cβ©F ntcf_const π β t')β¦NTMapβ¦)"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "u'β¦NTMapβ¦β¦aβ¦ = (ΞΌ ββ©Nβ©Tβ©Cβ©F ntcf_const π β t')β¦NTMapβ¦β¦aβ¦"
if "a ββ©β πβ©β (u'β¦NTMapβ¦)" for a
proof-
from that have "a ββ©β πβ¦Objβ¦" by (cs_prems cs_simp: cat_cs_simps)
with t' show "u'β¦NTMapβ¦β¦aβ¦ = (ΞΌ ββ©Nβ©Tβ©Cβ©F ntcf_const π β t')β¦NTMapβ¦β¦aβ¦"
by
(
cs_concl
cs_simp:
cat_cs_simps
Ο'_NTMap_app
cat_parallel_cs_simps
the_cat_discrete_components(1)
Ξ΅'_NTMap_app[symmetric]
Ξ΅'_NTMap_app_I2
Ο'_NTMap_app'[symmetric]
cs_intro: cat_cs_intros cat_parallel_cs_intros
)
qed
qed auto
qed simp_all
fix t'' assume prems':
"t'' : r' β¦βββ E" "u' = ΞΌ ββ©Nβ©Tβ©Cβ©F ntcf_const π β t''"
then have u'_NTMap_app_x:
"u'β¦NTMapβ¦β¦xβ¦ = (ΞΌ ββ©Nβ©Tβ©Cβ©F ntcf_const π β t'')β¦NTMapβ¦β¦xβ¦"
for x
by simp
have "?Ο'β¦NTMapβ¦β¦jβ¦ = Οβ©Oβ¦NTMapβ¦β¦jβ¦ ββ©Aβββ (Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ ββ©Aβββ t'')"
if "j ββ©β πβ¦Objβ¦" for j
using u'_NTMap_app_x[of j] prems'(1) that
by
(
cs_prems
cs_simp:
cat_cs_simps
cat_discrete_cs_simps
cat_parallel_cs_simps
the_cat_discrete_components(1)
cs_intro: cat_cs_intros cat_parallel_cs_intros
)
(simp add: Ο'_NTMap_app[OF that, symmetric])
moreover from prems'(1) have "Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ ββ©Aβββ t'' : r' β¦βββ Pβ©O"
by
(
cs_concl
cs_simp: cat_cs_simps cat_parallel_cs_simps
cs_intro: cat_cs_intros cat_parallel_cs_intros
)
ultimately have [cat_cs_simps]:
"Ξ΅β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ ββ©Aβββ t'' = h'"
by (intro unique_h') simp
show "t'' = t'"
by (rule unique_t', intro prems'(1))
(cs_concl cs_simp: Ξ΅'_NTMap_app_I2 cat_cs_simps)
qed
qed
qed
then show ?thesis using that by clarsimp
qed
lemma cat_colimit_of_cat_prod_obj_and_cat_coequalizer:
assumes "π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
and "βπ π π€ π£. β¦ π£ : π β¦βββ π; π€ : π β¦βββ π β§ βΉ
βE Ξ΅. Ξ΅ : (π,π,π€,π£) >β©Cβ©Fβ©.β©cβ©oβ©eβ©q E : βββ§2β©C β¦β¦β©CβΞ±β β"
and "βA. tm_cf_discrete Ξ± (πβ¦Objβ¦) A β βΉ
βP Ο. Ο : A >β©Cβ©Fβ©.β©β P : πβ¦Objβ¦ β¦β¦β©CβΞ±β β"
and "βA. tm_cf_discrete Ξ± (πβ¦Arrβ¦) A β βΉ
βP Ο. Ο : A >β©Cβ©Fβ©.β©β P : πβ¦Arrβ¦ β¦β¦β©CβΞ±β β"
obtains r u where "u : π >β©Cβ©Fβ©.β©cβ©oβ©lβ©iβ©m r : π β¦β¦β©CβΞ±β β"
proof-
interpret π: is_tm_functor Ξ± π β π by (rule assms(1))
have "βE Ξ΅. Ξ΅ : E <β©Cβ©Fβ©.β©eβ©q (π,π,π€,π£) : βββ§2β©C β¦β¦β©CβΞ±β op_cat β"
if "π£ : π β¦βββ π" "π€ : π β¦βββ π" for π π π€ π£
proof-
from assms(2)[OF that(1,2)] obtain E Ξ΅
where Ξ΅: "Ξ΅ : (π,π,π€,π£) >β©Cβ©Fβ©.β©cβ©oβ©eβ©q E : βββ§2β©C β¦β¦β©CβΞ±β β"
by clarsimp
interpret Ξ΅: is_cat_coequalizer Ξ± π π π€ π£ β E Ξ΅ by (rule Ξ΅)
from Ξ΅.is_cat_equalizer_op[unfolded cat_op_simps] show ?thesis by auto
qed
moreover have "βP Ο. Ο : P <β©Cβ©Fβ©.β©β A : πβ¦Objβ¦ β¦β¦β©CβΞ±β op_cat β"
if "tm_cf_discrete Ξ± (πβ¦Objβ¦) A (op_cat β)" for A
proof-
interpret tm_cf_discrete Ξ± βΉπβ¦Objβ¦βΊ A βΉop_cat ββΊ by (rule that)
from assms(3)[OF tm_cf_discrete_op[unfolded cat_op_simps]] obtain P Ο
where Ο: "Ο : A >β©Cβ©Fβ©.β©β P : πβ¦Objβ¦ β¦β¦β©CβΞ±β β"
by clarsimp
interpret Ο: is_cat_obj_coprod Ξ± βΉπβ¦Objβ¦βΊ A β P Ο by (rule Ο)
from Ο.is_cat_obj_prod_op show ?thesis by auto
qed
moreover have "βP Ο. Ο : P <β©Cβ©Fβ©.β©β A : πβ¦Arrβ¦ β¦β¦β©CβΞ±β op_cat β"
if "tm_cf_discrete Ξ± (πβ¦Arrβ¦) A (op_cat β)" for A
proof-
interpret tm_cf_discrete Ξ± βΉπβ¦Arrβ¦βΊ A βΉop_cat ββΊ by (rule that)
from assms(4)[OF tm_cf_discrete_op[unfolded cat_op_simps]] obtain P Ο
where Ο: "Ο : A >β©Cβ©Fβ©.β©β P : πβ¦Arrβ¦ β¦β¦β©CβΞ±β β"
by clarsimp
interpret Ο: is_cat_obj_coprod Ξ± βΉπβ¦Arrβ¦βΊ A β P Ο by (rule Ο)
from Ο.is_cat_obj_prod_op show ?thesis by auto
qed
ultimately obtain u r where u:
"u : r <β©Cβ©Fβ©.β©lβ©iβ©m op_cf π : op_cat π β¦β¦β©CβΞ±β op_cat β"
by
(
rule cat_limit_of_cat_prod_obj_and_cat_equalizer[
OF π.is_tm_functor_op, unfolded cat_op_simps
]
)
interpret u: is_cat_limit Ξ± βΉop_cat πβΊ βΉop_cat ββΊ βΉop_cf πβΊ r u by (rule u)
from u.is_cat_colimit_op[unfolded cat_op_simps] that show ?thesis by simp
qed
textβΉ\newpageβΊ
endTheory CZH_UCAT_Complete
sectionβΉCompleteness for categoriesβΊ
theory CZH_UCAT_Complete
imports CZH_UCAT_Limit
begin
subsectionβΉSmall-complete categoryβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
locale cat_small_complete = category Ξ± β for Ξ± β +
assumes cat_small_complete:
"βπ π. π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β β βΉ βu r. u : r <β©Cβ©Fβ©.β©lβ©iβ©m π : π β¦β¦β©CβΞ±β β"
locale cat_small_cocomplete = category Ξ± β for Ξ± β +
assumes cat_small_cocomplete:
"βπ π. π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β β βΉ βu r. u : π >β©Cβ©Fβ©.β©cβ©oβ©lβ©iβ©m r : π β¦β¦β©CβΞ±β β"
textβΉRules.βΊ
mk_ide rf cat_small_complete_def[unfolded cat_small_complete_axioms_def]
|intro cat_small_completeI|
|dest cat_small_completeD[dest]|
|elim cat_small_completeE[elim]|
lemma cat_small_completeE'[elim]:
assumes "cat_small_complete Ξ± β" and "π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
obtains u r where "u : r <β©Cβ©Fβ©.β©lβ©iβ©m π : π β¦β¦β©CβΞ±β β"
using assms by auto
mk_ide rf cat_small_cocomplete_def[unfolded cat_small_cocomplete_axioms_def]
|intro cat_small_cocompleteI|
|dest cat_small_cocompleteD[dest]|
|elim cat_small_cocompleteE[elim]|
lemma cat_small_cocompleteE'[elim]:
assumes "cat_small_cocomplete Ξ± β" and "π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
obtains u r where "u : π >β©Cβ©Fβ©.β©cβ©oβ©lβ©iβ©m r : π β¦β¦β©CβΞ±β β"
using assms by auto
subsubsectionβΉDualityβΊ
lemma (in cat_small_complete) cat_small_cocomplete_op[cat_op_intros]:
"cat_small_cocomplete Ξ± (op_cat β)"
proof(intro cat_small_cocompleteI)
fix π π assume "π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β op_cat β"
then interpret π: is_tm_functor Ξ± π βΉop_cat ββΊ π .
from cat_small_complete[OF π.is_tm_functor_op[unfolded cat_op_simps]]
obtain u r where u: "u : r <β©Cβ©Fβ©.β©lβ©iβ©m op_cf π : op_cat π β¦β¦β©CβΞ±β β"
by auto
then interpret u: is_cat_limit Ξ± βΉop_cat πβΊ β βΉop_cf πβΊ r u .
from u.is_cat_colimit_op[unfolded cat_op_simps] show
"βu r. u : π >β©Cβ©Fβ©.β©cβ©oβ©lβ©iβ©m r : π β¦β¦β©CβΞ±β op_cat β"
by auto
qed (auto intro: cat_cs_intros)
lemmas [cat_op_intros] = cat_small_complete.cat_small_cocomplete_op
lemma (in cat_small_cocomplete) cat_small_complete_op[cat_op_intros]:
"cat_small_complete Ξ± (op_cat β)"
proof(intro cat_small_completeI)
fix π π assume prems: "π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β op_cat β"
then interpret π: is_tm_functor Ξ± π βΉop_cat ββΊ π .
from cat_small_cocomplete[OF π.is_tm_functor_op[unfolded cat_op_simps]]
obtain u r where u: "u : op_cf π >β©Cβ©Fβ©.β©cβ©oβ©lβ©iβ©m r : op_cat π β¦β¦β©CβΞ±β β"
by auto
interpret u: is_cat_colimit Ξ± βΉop_cat πβΊ β βΉop_cf πβΊ r u by (rule u)
from u.is_cat_limit_op[unfolded cat_op_simps] show
"βu r. u : r <β©Cβ©Fβ©.β©lβ©iβ©m π : π β¦β¦β©CβΞ±β op_cat β"
by auto
qed (auto intro: cat_cs_intros)
lemmas [cat_op_intros] = cat_small_cocomplete.cat_small_complete_op
subsubsectionβΉA category with equalizers and small products is small-completeβΊ
lemma (in category) cat_small_complete_if_eq_and_obj_prod:
assumes "βπ π π€ π£. β¦ π£ : π β¦βββ π; π€ : π β¦βββ π β§ βΉ
βE Ξ΅. Ξ΅ : E <β©Cβ©Fβ©.β©eβ©q (π,π,π€,π£) : βββ§2β©C β¦β¦β©CβΞ±β β"
and "βA I. tm_cf_discrete Ξ± I A β βΉ βP Ο. Ο : P <β©Cβ©Fβ©.β©β A : I β¦β¦β©CβΞ±β β"
shows "cat_small_complete Ξ± β"
proof(intro cat_small_completeI)
fix π π assume prems: "π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
then interpret π: is_tm_functor Ξ± π β π .
show "βu r. u : r <β©Cβ©Fβ©.β©lβ©iβ©m π : π β¦β¦β©CβΞ±β β"
by (rule cat_limit_of_cat_prod_obj_and_cat_equalizer[OF prems assms(1)])
(auto intro: assms(2))
qed (auto simp: cat_cs_intros)
lemma (in category) cat_small_cocomplete_if_eq_and_obj_prod:
assumes "βπ π π€ π£. β¦ π£ : π β¦βββ π; π€ : π β¦βββ π β§ βΉ
βE Ξ΅. Ξ΅ : (π,π,π€,π£) >β©Cβ©Fβ©.β©cβ©oβ©eβ©q E : βββ§2β©C β¦β¦β©CβΞ±β β"
and "βA I. tm_cf_discrete Ξ± I A β βΉ βP Ο. Ο : A >β©Cβ©Fβ©.β©β P : I β¦β¦β©CβΞ±β β"
shows "cat_small_cocomplete Ξ± β"
proof-
have "βE Ξ΅. Ξ΅ : E <β©Cβ©Fβ©.β©eβ©q (π,π,π€,π£) : βββ§2β©C β¦β¦β©CβΞ±β op_cat β"
if "π£ : π β¦βββ π" and "π€ : π β¦βββ π" for π π π€ π£
proof-
from assms(1)[OF that] obtain Ξ΅ E where
Ξ΅: "Ξ΅ : (π,π,π€,π£) >β©Cβ©Fβ©.β©cβ©oβ©eβ©q E : βββ§2β©C β¦β¦β©CβΞ±β β"
by clarsimp
interpret Ξ΅: is_cat_coequalizer Ξ± π π π€ π£ β E Ξ΅ by (rule Ξ΅)
from Ξ΅.is_cat_equalizer_op show ?thesis by auto
qed
moreover have "βP Ο. Ο : P <β©Cβ©Fβ©.β©β A : I β¦β¦β©CβΞ±β op_cat β"
if "tm_cf_discrete Ξ± I A (op_cat β)" for A I
proof-
interpret tm_cf_discrete Ξ± I A βΉop_cat ββΊ by (rule that)
from assms(2)[OF tm_cf_discrete_op[unfolded cat_op_simps]] obtain P Ο
where Ο: "Ο : A >β©Cβ©Fβ©.β©β P : I β¦β¦β©CβΞ±β β"
by auto
interpret Ο: is_cat_obj_coprod Ξ± I A β P Ο by (rule Ο)
from Ο.is_cat_obj_prod_op show ?thesis by auto
qed
ultimately interpret cat_small_complete Ξ± βΉop_cat ββΊ
by
(
rule category.cat_small_complete_if_eq_and_obj_prod[
OF category_op, unfolded cat_op_simps
]
)
show ?thesis by (rule cat_small_cocomplete_op[unfolded cat_op_simps])
qed
subsectionβΉFinite-complete categoryβΊ
locale cat_finite_complete = category Ξ± β for Ξ± β +
assumes cat_finite_complete:
"βπ π. β¦ finite_category Ξ± π; π : π β¦β¦β©CβΞ±β β β§ βΉ
βu r. u : r <β©Cβ©Fβ©.β©lβ©iβ©m π : π β¦β¦β©CβΞ±β β"
locale cat_finite_cocomplete = category Ξ± β for Ξ± β +
assumes cat_finite_cocomplete:
"βπ π. β¦ finite_category Ξ± π; π : π β¦β¦β©CβΞ±β β β§ βΉ
βu r. u : π >β©Cβ©Fβ©.β©cβ©oβ©lβ©iβ©m r : π β¦β¦β©CβΞ±β β"
textβΉRules.βΊ
mk_ide rf cat_finite_complete_def[unfolded cat_finite_complete_axioms_def]
|intro cat_finite_completeI|
|dest cat_finite_completeD[dest]|
|elim cat_finite_completeE[elim]|
lemma cat_finite_completeE'[elim]:
assumes "cat_finite_complete Ξ± β"
and "finite_category Ξ± π"
and "π : π β¦β¦β©CβΞ±β β"
obtains u r where "u : r <β©Cβ©Fβ©.β©lβ©iβ©m π : π β¦β¦β©CβΞ±β β"
using assms by auto
mk_ide rf cat_finite_cocomplete_def[unfolded cat_finite_cocomplete_axioms_def]
|intro cat_finite_cocompleteI|
|dest cat_finite_cocompleteD[dest]|
|elim cat_finite_cocompleteE[elim]|
lemma cat_finite_cocompleteE'[elim]:
assumes "cat_finite_cocomplete Ξ± β"
and "finite_category Ξ± π"
and "π : π β¦β¦β©CβΞ±β β"
obtains u r where "u : π >β©Cβ©Fβ©.β©cβ©oβ©lβ©iβ©m r : π β¦β¦β©CβΞ±β β"
using assms by auto
textβΉElementary properties.βΊ
sublocale cat_small_complete β cat_finite_complete
proof(intro cat_finite_completeI)
fix π π assume prems: "finite_category Ξ± π" "π : π β¦β¦β©CβΞ±β β"
interpret π: is_functor Ξ± π β π by (rule prems(2))
from cat_small_complete_axioms show "βu r. u : r <β©Cβ©Fβ©.β©lβ©iβ©m π : π β¦β¦β©CβΞ±β β"
by (auto intro: π.cf_is_tm_functor_if_HomDom_finite_category[OF prems(1)])
qed (auto intro: cat_cs_intros)
sublocale cat_small_cocomplete β cat_finite_cocomplete
proof(intro cat_finite_cocompleteI)
fix π π assume prems: "finite_category Ξ± π" "π : π β¦β¦β©CβΞ±β β"
interpret π: is_functor Ξ± π β π by (rule prems(2))
from cat_small_cocomplete_axioms show "βu r. u : π >β©Cβ©Fβ©.β©cβ©oβ©lβ©iβ©m r : π β¦β¦β©CβΞ±β β"
by (auto intro: π.cf_is_tm_functor_if_HomDom_finite_category[OF prems(1)])
qed (auto intro: cat_cs_intros)
subsectionβΉDiscrete functor with tiny maps to the category βΉSetβΊβΊ
lemma (in π΅) tm_cf_discrete_cat_Set_if_VLambda_in_Vset:
assumes "VLambda I F ββ©β Vset Ξ±"
shows "tm_cf_discrete Ξ± I F (cat_Set Ξ±)"
proof(intro tm_cf_discreteI)
from assms have vrange_F_in_Vset: "ββ©β (VLambda I F) ββ©β Vset Ξ±"
by (auto intro: vrange_in_VsetI)
show "(Ξ»iββ©βI. cat_Set Ξ±β¦CIdβ¦β¦F iβ¦) ββ©β Vset Ξ±"
proof(rule vbrelation.vbrelation_Limit_in_VsetI)
from assms show "πβ©β (Ξ»iββ©βI. cat_Set Ξ±β¦CIdβ¦β¦F iβ¦) ββ©β Vset Ξ±"
by (metis vdomain_VLambda vdomain_in_VsetI)
define Q where
"Q i =
(
if i = 0
then VPow ((ββ©βiββ©βI. F i) Γβ©β (ββ©βiββ©βI. F i))
else set (F ` elts I)
)"
for i :: V
have "ββ©β (Ξ»iββ©βI. cat_Set Ξ±β¦CIdβ¦β¦F iβ¦) ββ©β (ββ©βiββ©β set {0, 1β©β, 2β©β}. Q i)"
proof(intro vsubsetI, unfold cat_Set_components)
fix y assume "y ββ©β ββ©β (Ξ»iββ©βI. VLambda (Vset Ξ±) id_Setβ¦F iβ¦)"
then obtain i where i: "i ββ©β I"
and y_def: "y = VLambda (Vset Ξ±) id_Setβ¦F iβ¦"
by auto
from i have "F i ββ©β ββ©β (VLambda I F)" by auto
with vrange_F_in_Vset have "F i ββ©β Vset Ξ±" by auto
then have y_def: "y = id_Set (F i)" unfolding y_def by auto
show "y ββ©β (ββ©βiββ©βset {0, 1β©β, 2β©β}. Q i)"
unfolding y_def
proof(intro vproductI, unfold Ball_def; (intro allI impI)?)
show "πβ©β (id_Rel (F i)) = set {0, 1β©β, 2β©β}"
by (simp add: id_Rel_def incl_Rel_def three nat_omega_simps)
fix j assume "j ββ©β set {0, 1β©β, 2β©β}"
then consider βΉj = 0βΊ | βΉj = 1β©ββΊ | βΉj = 2β©ββΊ by auto
then show "id_Rel (F i)β¦jβ¦ ββ©β Q j"
proof cases
case 1
from i show ?thesis
unfolding 1
by
(
subst arr_field_simps(1)[symmetric],
unfold id_Rel_components Q_def
)
force
next
case 2
from i show ?thesis
unfolding 2
by
(
subst arr_field_simps(2)[symmetric],
unfold id_Rel_components Q_def
)
auto
next
case 3
from i show ?thesis
unfolding 3
by
(
subst arr_field_simps(3)[symmetric],
unfold id_Rel_components Q_def
)
auto
qed
qed (auto simp: id_Rel_def cat_Set_cs_intros)
qed
moreover have "(ββ©βiββ©β set {0, 1β©β, 2β©β}. Q i) ββ©β Vset Ξ±"
proof(rule Limit_vproduct_in_VsetI)
show "set {0, 1β©β, 2β©β} ββ©β Vset Ξ±" unfolding three[symmetric] by simp
from assms have "VPow ((ββ©βiββ©βI. F i) Γβ©β (ββ©βiββ©βI. F i)) ββ©β Vset Ξ±"
by
(
intro
Limit_VPow_in_VsetI
Limit_vtimes_in_VsetI
Limit_vifunion_in_Vset_if_VLambda_in_VsetI
)
auto
then show "Q i ββ©β Vset Ξ±" if "i ββ©β set {0, 1β©β, 2β©β}" for i
using that vrange_VLambda
by (auto intro!: vrange_F_in_Vset simp: Q_def nat_omega_simps)
qed auto
ultimately show "ββ©β (Ξ»iββ©βI. cat_Set Ξ±β¦CIdβ¦β¦F iβ¦) ββ©β Vset Ξ±"
by (meson vsubset_in_VsetI)
qed auto
fix i assume prems: "i ββ©β I"
from assms have "ββ©β (VLambda I F) ββ©β Vset Ξ±" by (auto simp: vrange_in_VsetI)
moreover from prems have "F i ββ©β ββ©β (VLambda I F)" by auto
ultimately show "F i ββ©β cat_Set Ξ±β¦Objβ¦" unfolding cat_Set_components by auto
qed (cs_concl cs_intro: cat_cs_intros assms)+
subsectionβΉProduct cone for the category βΉSetβΊβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition ntcf_Set_obj_prod :: "V β V β (V β V) β V"
where "ntcf_Set_obj_prod Ξ± I F = ntcf_obj_prod_base
(cat_Set Ξ±) I F (ββ©βiββ©βI. F i) (Ξ»i. vprojection_arrow I F i)"
textβΉComponents.βΊ
lemma ntcf_Set_obj_prod_components:
shows "ntcf_Set_obj_prod Ξ± I Fβ¦NTMapβ¦ =
(Ξ»iββ©β:β©C Iβ¦Objβ¦. vprojection_arrow I F i)"
and "ntcf_Set_obj_prod Ξ± I Fβ¦NTDomβ¦ =
cf_const (:β©C I) (cat_Set Ξ±) (ββ©βiββ©βI. F i)"
and "ntcf_Set_obj_prod Ξ± I Fβ¦NTCodβ¦ = :β: I F (cat_Set Ξ±)"
and "ntcf_Set_obj_prod Ξ± I Fβ¦NTDGDomβ¦ = :β©C I"
and "ntcf_Set_obj_prod Ξ± I Fβ¦NTDGCodβ¦ = cat_Set Ξ±"
unfolding ntcf_Set_obj_prod_def ntcf_obj_prod_base_components by simp_all
subsubsectionβΉNatural transformation mapβΊ
mk_VLambda ntcf_Set_obj_prod_components(1)
|vsv ntcf_Set_obj_prod_NTMap_vsv[cat_cs_intros]|
|vdomain ntcf_Set_obj_prod_NTMap_vdomain[cat_cs_simps]|
|app ntcf_Set_obj_prod_NTMap_app[cat_cs_simps]|
subsubsectionβΉProduct cone for the category βΉSetβΊ is a universal coneβΊ
lemma (in π΅) tm_cf_discrete_ntcf_obj_prod_base_is_cat_obj_prod:
assumes "VLambda I F ββ©β Vset Ξ±"
shows "ntcf_Set_obj_prod Ξ± I F : (ββ©βiββ©βI. F i) <β©Cβ©Fβ©.β©β F : I β¦β¦β©CβΞ±β cat_Set Ξ±"
proof(intro is_cat_obj_prodI is_cat_limitI')
interpret Set: tm_cf_discrete Ξ± I F βΉcat_Set Ξ±βΊ
by (rule tm_cf_discrete_cat_Set_if_VLambda_in_Vset[OF assms])
let ?F = βΉntcf_Set_obj_prod Ξ± I FβΊ
show "cf_discrete Ξ± I F (cat_Set Ξ±)"
by (auto simp: cat_small_discrete_cs_intros)
show F_is_cat_cone: "?F :
(ββ©βiββ©βI. F i) <β©Cβ©Fβ©.β©cβ©oβ©nβ©e :β: I F (cat_Set Ξ±) : :β©C I β¦β¦β©CβΞ±β cat_Set Ξ±"
unfolding ntcf_Set_obj_prod_def
proof(rule Set.tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone)
show "(ββ©βiββ©βI. F i) ββ©β cat_Set Ξ±β¦Objβ¦"
unfolding cat_Set_components
by
(
intro
Limit_vproduct_in_Vset_if_VLambda_in_VsetI
Set.tm_cf_discrete_ObjMap_in_Vset
)
auto
qed (intro vprojection_arrow_is_arr Set.tm_cf_discrete_ObjMap_in_Vset)
interpret F: is_cat_cone
Ξ± βΉββ©βiββ©βI. F iβΊ βΉ:β©C IβΊ βΉcat_Set Ξ±βΊ βΉ:β: I F (cat_Set Ξ±)βΊ βΉ?FβΊ
by (rule F_is_cat_cone)
fix Ο' P' assume prems:
"Ο' : P' <β©Cβ©Fβ©.β©cβ©oβ©nβ©e :β: I F (cat_Set Ξ±) : :β©C I β¦β¦β©CβΞ±β cat_Set Ξ±"
let ?Ο'i = βΉΞ»i. Ο'β¦NTMapβ¦β¦iβ¦βΊ
let ?up' = βΉcat_Set_obj_prod_up I F P' ?Ο'iβΊ
interpret Ο': is_cat_cone Ξ± P' βΉ:β©C IβΊ βΉcat_Set Ξ±βΊ βΉ:β: I F (cat_Set Ξ±)βΊ Ο'
by (rule prems(1))
show "β!f'.
f' : P' β¦βcat_Set Ξ±β (ββ©βiββ©βI. F i) β§
Ο' = ?F ββ©Nβ©Tβ©Cβ©F ntcf_const (:β©C I) (cat_Set Ξ±) f'"
proof(intro ex1I conjI; (elim conjE)?)
show up': "?up' : P' β¦βcat_Set Ξ±β (ββ©βiββ©βI. F i)"
proof(rule cat_Set_obj_prod_up_cat_Set_is_arr)
show "P' ββ©β Vset Ξ±" by (auto intro: cat_cs_intros cat_lim_cs_intros)
fix i assume "i ββ©β I"
then show "Ο'β¦NTMapβ¦β¦iβ¦ : P' β¦βcat_Set Ξ±β F i"
by
(
cs_concl
cs_simp:
the_cat_discrete_components(1)
cat_cs_simps cat_discrete_cs_simps
cs_intro: cat_cs_intros
)
qed (rule assms)
then have P': "P' ββ©β Vset Ξ±"
by (auto intro: cat_cs_intros cat_lim_cs_intros)
have Ο'i_i: "?Ο'i i : P' β¦βcat_Set Ξ±β F i" if "i ββ©β I" for i
using
Ο'.ntcf_NTMap_is_arr[unfolded the_cat_discrete_components(1), OF that]
that
by
(
cs_prems cs_simp:
cat_cs_simps cat_discrete_cs_simps the_cat_discrete_components(1)
)
from cat_Set_obj_prod_up_cat_Set_is_arr[OF P' assms(1) Ο'i_i] have Ο'i:
"cat_Set_obj_prod_up I F P' ?Ο'i : P' β¦βcat_Set Ξ±β (ββ©βiββ©βI. F i)".
show "Ο' = ?F ββ©Nβ©Tβ©Cβ©F ntcf_const (:β©C I) (cat_Set Ξ±) ?up'"
proof(rule ntcf_eqI, rule Ο'.is_ntcf_axioms)
from F_is_cat_cone Ο'i show
"?F ββ©Nβ©Tβ©Cβ©F ntcf_const (:β©C I) (cat_Set Ξ±) ?up' :
cf_const (:β©C I) (cat_Set Ξ±) P' β¦β©Cβ©F :β: I F (cat_Set Ξ±) :
:β©C I β¦β¦β©CβΞ±β cat_Set Ξ±"
by (cs_concl cs_intro: cat_cs_intros)
have dom_lhs: "πβ©β (Ο'β¦NTMapβ¦) = :β©C Iβ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps)
from F_is_cat_cone Ο'i have dom_rhs:
"πβ©β ((?F ββ©Nβ©Tβ©Cβ©F ntcf_const (:β©C I) (cat_Set Ξ±) ?up')β¦NTMapβ¦) = :β©C Iβ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "Ο'β¦NTMapβ¦ = (?F ββ©Nβ©Tβ©Cβ©F ntcf_const (:β©C I) (cat_Set Ξ±) ?up')β¦NTMapβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix i assume prems': "i ββ©β :β©C Iβ¦Objβ¦"
then have i: "i ββ©β I" unfolding the_cat_discrete_components by simp
have [cat_cs_simps]:
"vprojection_arrow I F i ββ©Aβcat_Set Ξ±β ?up' = Ο'β¦NTMapβ¦β¦iβ¦"
by
(
rule pdg_dghm_comp_dghm_proj_dghm_up[
OF P' assms Ο'i_i i, symmetric
]
)
auto
from Ο'i prems' show "Ο'β¦NTMapβ¦β¦iβ¦ =
(?F ββ©Nβ©Tβ©Cβ©F ntcf_const (:β©C I) (cat_Set Ξ±) ?up')β¦NTMapβ¦β¦iβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps cat_Rel_cs_simps cs_intro: cat_cs_intros
)
qed (auto simp: cat_cs_intros)
qed simp_all
fix f' assume prems:
"f' : P' β¦βcat_Set Ξ±β (ββ©βiββ©βI. F i)"
"Ο' = ?F ββ©Nβ©Tβ©Cβ©F ntcf_const (:β©C I) (cat_Set Ξ±) f'"
from prems(2) have Ο'_eq_F_f': "Ο'β¦NTMapβ¦β¦iβ¦β¦ArrValβ¦β¦aβ¦ =
(?F ββ©Nβ©Tβ©Cβ©F ntcf_const (:β©C I) (cat_Set Ξ±) f')β¦NTMapβ¦β¦iβ¦β¦ArrValβ¦β¦aβ¦"
if "i ββ©β I" and "a ββ©β P'" for i a
by simp
have [cat_Set_cs_simps]: "Ο'β¦NTMapβ¦β¦iβ¦β¦ArrValβ¦β¦aβ¦ = f'β¦ArrValβ¦β¦aβ¦β¦iβ¦"
if "i ββ©β I" and "a ββ©β P'" for i a
using
Ο'_eq_F_f'[OF that]
assms prems that
vprojection_arrow_is_arr[OF that(1) assms]
by
(
cs_prems
cs_simp:
cat_Set_cs_simps
cat_cs_simps
vprojection_arrow_app
the_cat_discrete_components(1)
cs_intro: cat_Set_cs_intros cat_cs_intros
)
note f' = cat_Set_is_arrD[OF prems(1)]
note up' = cat_Set_is_arrD[OF up']
interpret f': arr_Set Ξ± f' by (rule f'(1))
interpret u': arr_Set Ξ± βΉ(cat_Set_obj_prod_up I F P' (app (Ο'β¦NTMapβ¦)))βΊ
by (rule up'(1))
show "f' = ?up'"
proof(rule arr_Set_eqI[of Ξ±])
have dom_lhs: "πβ©β (f'β¦ArrValβ¦) = P'"
by (simp add: cat_Set_cs_simps cat_cs_simps f')
have dom_rhs:
"πβ©β (cat_Set_obj_prod_up I F P' (app (Ο'β¦NTMapβ¦))β¦ArrValβ¦) = P'"
by (simp add: cat_Set_cs_simps cat_cs_simps up')
show "f'β¦ArrValβ¦ = cat_Set_obj_prod_up I F P' (app (Ο'β¦NTMapβ¦))β¦ArrValβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix a assume prems': "a ββ©β P'"
from prems(1) prems' have "f'β¦ArrValβ¦β¦aβ¦ ββ©β (ββ©βiββ©βI. F i)"
by (cs_concl cs_intro: cat_Set_cs_intros)
note f'a = vproductD[OF this]
from prems' have dom_rhs:
"πβ©β (cat_Set_obj_prod_up I F P' (app (Ο'β¦NTMapβ¦))β¦ArrValβ¦β¦aβ¦) = I"
by (cs_concl cs_simp: cat_Set_cs_simps)
show "f'β¦ArrValβ¦β¦aβ¦ =
cat_Set_obj_prod_up I F P' (app (Ο'β¦NTMapβ¦))β¦ArrValβ¦β¦aβ¦"
proof(rule vsv_eqI, unfold f'a dom_rhs)
fix i assume "i ββ©β I"
with prems' show "f'β¦ArrValβ¦β¦aβ¦β¦iβ¦ =
cat_Set_obj_prod_up I F P' (app (Ο'β¦NTMapβ¦))β¦ArrValβ¦β¦aβ¦β¦iβ¦"
by (cs_concl cs_simp: cat_Set_cs_simps)
qed (simp_all add: prems' f'a(1) cat_Set_obj_prod_up_ArrVal_app)
qed auto
qed (simp_all add: cat_Set_obj_prod_up_components f' up'(1))
qed
qed
subsectionβΉEqualizer for the category βΉSetβΊβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
abbreviation ntcf_Set_equalizer_map :: "V β V β V β V β V β V"
where "ntcf_Set_equalizer_map Ξ± a g f i β‘
(
i = πβ©Pβ©L ?
incl_Set (vequalizer a g f) a :
g ββ©Aβcat_Set Ξ±β incl_Set (vequalizer a g f) a
)"
definition ntcf_Set_equalizer :: "V β V β V β V β V β V"
where "ntcf_Set_equalizer Ξ± a b g f = ntcf_equalizer_base
(cat_Set Ξ±) a b g f (vequalizer a g f) (ntcf_Set_equalizer_map Ξ± a g f)"
textβΉComponents.βΊ
context
fixes a g f Ξ± :: V
begin
lemmas ntcf_Set_equalizer_components =
ntcf_equalizer_base_components[
where β=βΉcat_Set Ξ±βΊ
and e=βΉntcf_Set_equalizer_map Ξ± a g fβΊ
and E=βΉvequalizer a g fβΊ
and π=a and π€=g and π£=f,
folded ntcf_Set_equalizer_def
]
end
subsubsectionβΉNatural transformation mapβΊ
mk_VLambda ntcf_Set_equalizer_components(1)
|vsv ntcf_Set_equalizer_NTMap_vsv[cat_Set_cs_intros]|
|vdomain ntcf_Set_equalizer_NTMap_vdomain[cat_Set_cs_simps]|
|app ntcf_Set_equalizer_NTMap_app|
lemma ntcf_Set_equalizer_2_NTMap_app_π[cat_Set_cs_simps]:
assumes "x = πβ©Pβ©L"
shows
"ntcf_Set_equalizer Ξ± a b g fβ¦NTMapβ¦β¦xβ¦ =
incl_Set (vequalizer a g f) a"
unfolding assms the_cat_parallel_components(1) ntcf_Set_equalizer_components
by simp
lemma ntcf_Set_equalizer_2_NTMap_app_π[cat_Set_cs_simps]:
assumes "x = πβ©Pβ©L"
shows
"ntcf_Set_equalizer Ξ± a b g fβ¦NTMapβ¦β¦xβ¦ =
g ββ©Aβcat_Set Ξ±β incl_Set (vequalizer a g f) a"
unfolding assms the_cat_parallel_components(1) ntcf_Set_equalizer_components
using cat_PL_ineq
by auto
subsubsectionβΉEqualizer for the category βΉSetβΊ is an equalizerβΊ
lemma (in π΅) ntcf_Set_equalizer_2_is_cat_equalizer_2:
assumes "π€ : π β¦βcat_Set Ξ±β π" and "π£ : π β¦βcat_Set Ξ±β π"
shows "ntcf_Set_equalizer Ξ± π π π€ π£ :
vequalizer π π€ π£ <β©Cβ©Fβ©.β©eβ©q (π,π,π€,π£) : βββ§2β©C β¦β¦β©CβΞ±β cat_Set Ξ±"
proof(intro is_cat_equalizerI is_cat_equalizerI is_cat_limitI')
let ?II_II = βΉβββββ (cat_Set Ξ±) πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©L π π π€ π£βΊ
and ?II = βΉβββ©C πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©LβΊ
note π€ = cat_Set_is_arrD[OF assms(1)]
interpret π€: arr_Set Ξ± π€
rewrites "π€β¦ArrDomβ¦ = π" and "π€β¦ArrCodβ¦ = π"
by (rule π€(1)) (simp_all add: π€)
note π£ = cat_Set_is_arrD[OF assms(2)]
interpret π£: arr_Set Ξ± π£
rewrites "π£β¦ArrDomβ¦ = π" and "π£β¦ArrCodβ¦ = π"
by (rule π£(1)) (simp_all add: π£)
note [cat_Set_cs_intros] = π€.arr_Set_ArrDom_in_Vset π£.arr_Set_ArrCod_in_Vset
let ?incl = βΉincl_Set (vequalizer π π€ π£) πβΊ
show πππ€π£_is_cat_cone: "ntcf_Set_equalizer Ξ± π π π€ π£ :
vequalizer π π€ π£ <β©Cβ©Fβ©.β©cβ©oβ©nβ©e ?II_II : ?II β¦β¦β©CβΞ±β cat_Set Ξ±"
unfolding ntcf_Set_equalizer_def
proof
(
intro
category.cat_ntcf_equalizer_base_is_cat_cone
category.cat_cf_parallel_cat_equalizer
)
from assms show
"(πβ©Pβ©L = πβ©Pβ©L ? ?incl : π€ ββ©Aβcat_Set Ξ±β ?incl) :
vequalizer π π€ π£ β¦βcat_Set Ξ±β π"
by
(
cs_concl
cs_simp: V_cs_simps
cs_intro:
V_cs_intros cat_Set_cs_intros cat_cs_intros
cat_PL_ineq[symmetric]
)
show
"(πβ©Pβ©L = πβ©Pβ©L ? ?incl : π€ ββ©Aβcat_Set Ξ±β ?incl) =
π€ ββ©Aβcat_Set Ξ±β (πβ©Pβ©L = πβ©Pβ©L ? ?incl : π€ ββ©Aβcat_Set Ξ±β ?incl)"
by
(
cs_concl
cs_simp: V_cs_simps
cs_intro:
V_cs_intros cat_Set_cs_intros cat_cs_intros
cat_PL_ineq[symmetric]
)
from assms show
"(πβ©Pβ©L = πβ©Pβ©L ? ?incl : π€ ββ©Aβcat_Set Ξ±β ?incl) =
π£ ββ©Aβcat_Set Ξ±β (πβ©Pβ©L = πβ©Pβ©L ? ?incl : π€ ββ©Aβcat_Set Ξ±β ?incl)"
by
(
cs_concl
cs_simp: V_cs_simps cat_Set_incl_Set_commute
cs_intro: V_cs_intros cat_PL_ineq[symmetric]
)
qed
(
cs_concl
cs_intro: cat_cs_intros V_cs_intros cat_Set_cs_intros assms
cs_simp: V_cs_simps cat_cs_simps
)+
interpret πππ€π£: is_cat_cone
Ξ± βΉvequalizer π π€ π£βΊ ?II βΉcat_Set Ξ±βΊ ?II_II βΉntcf_Set_equalizer Ξ± π π π€ π£βΊ
by (rule πππ€π£_is_cat_cone)
show "β!f'.
f' : r' β¦βcat_Set Ξ±β vequalizer π π€ π£ β§
u' = ntcf_Set_equalizer Ξ± π π π€ π£ ββ©Nβ©Tβ©Cβ©F ntcf_const ?II (cat_Set Ξ±) f'"
if "u' : r' <β©Cβ©Fβ©.β©cβ©oβ©nβ©e ?II_II : ?II β¦β¦β©CβΞ±β cat_Set Ξ±" for u' r'
proof-
interpret u': is_cat_cone Ξ± r' ?II βΉcat_Set Ξ±βΊ ?II_II u' by (rule that(1))
have "πβ©Pβ©L ββ©β βββ©C πβ©Pβ©L πβ©Pβ©L π€β©Pβ©L π£β©Pβ©Lβ¦Objβ¦"
unfolding the_cat_parallel_components(1) by simp
from
u'.ntcf_NTMap_is_arr[OF this]
πππ€π£.NTDom.HomCod.cat_cf_parallel_cat_equalizer[OF assms]
have u'_πβ©Pβ©L_is_arr: "u'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ : r' β¦βcat_Set Ξ±β π"
by (cs_prems_atom_step cat_cs_simps)
(
cs_prems
cs_simp: cat_parallel_cs_simps
cs_intro:
cat_parallel_cs_intros
cat_cs_intros
category.cat_cf_parallel_cat_equalizer
)
note u'_πβ©Pβ©L = cat_Set_is_arrD[OF u'_πβ©Pβ©L_is_arr]
interpret u'_πβ©Pβ©L: arr_Set Ξ± βΉu'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦βΊ by (rule u'_πβ©Pβ©L(1))
have "πβ©Pβ©L ββ©β ?IIβ¦Objβ¦"
by (cs_concl cs_intro: cat_parallel_cs_intros)
from
u'.ntcf_NTMap_is_arr[OF this]
πππ€π£.NTDom.HomCod.cat_cf_parallel_cat_equalizer[OF assms]
have "u'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ : r' β¦βcat_Set Ξ±β π"
by
(
cs_prems
cs_simp: cat_cs_simps cat_parallel_cs_simps
cs_intro: cat_parallel_cs_intros
)
note u'_π€u' = cat_cone_cf_par_eps_NTMap_app(1)[OF that(1) assms]
define q where "q = [u'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦β¦ArrValβ¦, r', vequalizer π π€ π£]β©β"
have q_components[cat_Set_cs_simps]:
"qβ¦ArrValβ¦ = u'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦β¦ArrValβ¦"
"qβ¦ArrDomβ¦ = r'"
"qβ¦ArrCodβ¦ = vequalizer π π€ π£"
unfolding q_def arr_field_simps by (simp_all add: nat_omega_simps)
from cat_cone_cf_par_eps_NTMap_app[OF that(1) assms] have π€u'_eq_π£u':
"(π€ ββ©Aβcat_Set Ξ±β u'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦)β¦ArrValβ¦β¦xβ¦ =
(π£ ββ©Aβcat_Set Ξ±β u'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦)β¦ArrValβ¦β¦xβ¦"
for x
by simp
show ?thesis
proof(intro ex1I conjI; (elim conjE)?)
have u'_NTMap_vrange: "ββ©β (u'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦β¦ArrValβ¦) ββ©β vequalizer π π€ π£"
proof(rule vsubsetI)
fix y assume prems: "y ββ©β ββ©β (u'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦β¦ArrValβ¦)"
then obtain x where x: "x ββ©β πβ©β (u'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦β¦ArrValβ¦)"
and y_def: "y = u'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦β¦ArrValβ¦β¦xβ¦"
by (blast dest: u'_πβ©Pβ©L.ArrVal.vrange_atD)
have x: "x ββ©β r'"
by (use x u'_πβ©Pβ©L_is_arr in βΉcs_prems cs_simp: cat_cs_simpsβΊ)
from π€u'_eq_π£u'[of x] assms x u'_πβ©Pβ©L_is_arr have [simp]:
"π€β¦ArrValβ¦β¦u'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦β¦ArrValβ¦β¦xβ¦β¦ =
π£β¦ArrValβ¦β¦u'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦β¦ArrValβ¦β¦xβ¦β¦"
by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from prems u'_πβ©Pβ©L.arr_Set_ArrVal_vrange[unfolded u'_πβ©Pβ©L] show
"y ββ©β vequalizer π π€ π£"
by (intro vequalizerI, unfold y_def) auto
qed
show q_is_arr: "q : r' β¦βcat_Set Ξ±β vequalizer π π€ π£"
proof(intro cat_Set_is_arrI arr_SetI)
show "qβ¦ArrCodβ¦ ββ©β Vset Ξ±"
by (auto simp: q_components intro: cat_cs_intros cat_lim_cs_intros)
qed
(
auto
simp:
cat_Set_cs_simps nat_omega_simps
u'_πβ©Pβ©L
q_def
u'_NTMap_vrange
πππ€π£.NTDom.HomCod.cat_in_Obj_in_Vset
intro: cat_cs_intros cat_lim_cs_intros
)
from q_is_arr have π_q:
"incl_Set (vequalizer π π€ π£) π ββ©Aβcat_Set Ξ±β q :
r' β¦βcat_Set Ξ±β π"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: V_cs_intros cat_cs_intros cat_Set_cs_intros
)
interpret arr_Set Ξ± βΉincl_Set (vequalizer π π€ π£) π ββ©Aβcat_Set Ξ±β qβΊ
using π_q by (auto dest: cat_Set_is_arrD)
show "u' = ntcf_Set_equalizer Ξ± π π π€ π£ ββ©Nβ©Tβ©Cβ©F ntcf_const ?II (cat_Set Ξ±) q"
proof(rule ntcf_eqI)
from q_is_arr show
"ntcf_Set_equalizer Ξ± π π π€ π£ ββ©Nβ©Tβ©Cβ©F ntcf_const ?II (cat_Set Ξ±) q :
cf_const ?II (cat_Set Ξ±) r' β¦β©Cβ©F
?II_II : ?II β¦β¦β©CβΞ±β cat_Set Ξ±"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
have dom_lhs: "πβ©β (u'β¦NTMapβ¦) = ?IIβ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps)
from q_is_arr have dom_rhs:
"πβ©β
(
(ntcf_Set_equalizer Ξ± π π π€ π£ ββ©Nβ©Tβ©Cβ©F
ntcf_const ?II (cat_Set Ξ±) q
)β¦NTMapβ¦) = ?IIβ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "u'β¦NTMapβ¦ =
(
ntcf_Set_equalizer Ξ± π π π€ π£ ββ©Nβ©Tβ©Cβ©F ntcf_const ?II (cat_Set Ξ±) q
)β¦NTMapβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
show "vsv ((
ntcf_Set_equalizer Ξ± π π π€ π£ ββ©Nβ©Tβ©Cβ©F ntcf_const ?II (cat_Set Ξ±) q
)β¦NTMapβ¦)"
by (cs_concl cs_intro: cat_cs_intros)
fix a assume prems: "a ββ©β ?IIβ¦Objβ¦"
have [symmetric, cat_Set_cs_simps]:
"u'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ = incl_Set (vequalizer π π€ π£) π ββ©Aβcat_Set Ξ±β q"
proof(rule arr_Set_eqI[of Ξ±])
from u'_πβ©Pβ©L_is_arr have dom_lhs: "πβ©β (u'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦β¦ArrValβ¦) = r'"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from π_q have dom_rhs:
"πβ©β ((incl_Set (vequalizer π π€ π£) π ββ©Aβcat_Set Ξ±β q)β¦ArrValβ¦) = r'"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "u'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦β¦ArrValβ¦ =
(incl_Set (vequalizer π π€ π£) π ββ©Aβcat_Set Ξ±β q)β¦ArrValβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix a assume prems: "a ββ©β r'"
with u'_NTMap_vrange dom_lhs u'_πβ©Pβ©L.ArrVal.vsv_vimageI2 have
"u'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦β¦ArrValβ¦β¦aβ¦ ββ©β vequalizer π π€ π£"
by blast
with prems q_is_arr u'_πβ©Pβ©L_is_arr show
"u'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦β¦ArrValβ¦β¦aβ¦ =
(incl_Set (vequalizer π π€ π£) π ββ©Aβcat_Set Ξ±β q)β¦ArrValβ¦β¦aβ¦"
by
(
cs_concl
cs_simp: cat_Set_cs_simps cat_cs_simps
cs_intro: V_cs_intros cat_cs_intros cat_Set_cs_intros
)
qed auto
qed
(
use u'_πβ©Pβ©L π_q in βΉ
cs_concl cs_intro: cat_Set_is_arrD(1) cs_simp: cat_cs_simps
βΊ
)+
from q_is_arr have u'_NTMap_app_I: "u'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ =
(
ntcf_Set_equalizer Ξ± π π π€ π£ ββ©Nβ©Tβ©Cβ©F ntcf_const ?II (cat_Set Ξ±) q
)β¦NTMapβ¦β¦πβ©Pβ©Lβ¦"
by
(
cs_concl
cs_intro: cat_cs_intros cat_parallel_cs_intros
cs_simp: cat_Set_cs_simps cat_cs_simps V_cs_simps
)
from q_is_arr assms have u'_NTMap_app_sI: "u'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ =
(
ntcf_Set_equalizer Ξ± π π π€ π£ ββ©Nβ©Tβ©Cβ©F ntcf_const ?II (cat_Set Ξ±) q
)β¦NTMapβ¦β¦πβ©Pβ©Lβ¦"
by
(
cs_concl
cs_simp: cat_Set_cs_simps cat_cs_simps u'_π€u'
cs_intro:
V_cs_intros
cat_cs_intros
cat_Set_cs_intros
cat_parallel_cs_intros
)
from prems consider βΉa = πβ©Pβ©LβΊ | βΉa = πβ©Pβ©LβΊ
by (elim the_cat_parallel_ObjE)
then show
"u'β¦NTMapβ¦β¦aβ¦ =
(
ntcf_Set_equalizer Ξ± π π π€ π£ ββ©Nβ©Tβ©Cβ©F
ntcf_const ?II (cat_Set Ξ±) q
)β¦NTMapβ¦β¦aβ¦"
by cases (simp_all add: u'_NTMap_app_I u'_NTMap_app_sI)
qed auto
qed (simp_all add: u'.is_ntcf_axioms)
fix f' assume prems:
"f' : r' β¦βcat_Set Ξ±β vequalizer π π€ π£"
"u' = ntcf_Set_equalizer Ξ± π π π€ π£ ββ©Nβ©Tβ©Cβ©F ntcf_const ?II (cat_Set Ξ±) f'"
from prems(2) have u'_NTMap_app:
"u'β¦NTMapβ¦β¦xβ¦ =
(ntcf_Set_equalizer Ξ± π π π€ π£ ββ©Nβ©Tβ©Cβ©F
ntcf_const ?II (cat_Set Ξ±) f')β¦NTMapβ¦β¦xβ¦"
for x
by simp
have u'_f':
"u'β¦NTMapβ¦β¦πβ©Pβ©Lβ¦ = incl_Set (vequalizer π π€ π£) π ββ©Aβcat_Set Ξ±β f'"
using u'_NTMap_app[of πβ©Pβ©L] prems(1)
by
(
cs_prems
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_parallel_cs_intros
)
(cs_prems cs_simp: cat_Set_cs_simps cs_intro: cat_parallel_cs_intros)
note f' = cat_Set_is_arrD[OF prems(1)]
note q = cat_Set_is_arrD[OF q_is_arr]
interpret f': arr_Set Ξ± f' using prems(1) by (auto dest: cat_Set_is_arrD)
interpret q: arr_Set Ξ± q using q by (auto dest: cat_Set_is_arrD)
show "f' = q"
proof(rule arr_Set_eqI[of Ξ±])
have dom_lhs: "πβ©β (f'β¦ArrValβ¦) = r'" by (simp add: cat_Set_cs_simps f')
from q_is_arr have dom_rhs: "πβ©β (qβ¦ArrValβ¦) = r'"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_Set_cs_intros)
show "f'β¦ArrValβ¦ = qβ¦ArrValβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix i assume "i ββ©β r'"
with prems(1) show "f'β¦ArrValβ¦β¦iβ¦ = qβ¦ArrValβ¦β¦iβ¦"
by
(
cs_concl
cs_simp: cat_Set_cs_simps cat_cs_simps q_components u'_f'
cs_intro: V_cs_intros cat_cs_intros cat_Set_cs_intros
)
qed auto
qed
(
use prems(1) q_is_arr in βΉ
cs_concl cs_simp: cat_cs_simps cs_intro: q cat_Set_is_arrD
βΊ
)+
qed
qed
qed (auto intro: assms)
subsectionβΉThe category βΉSetβΊ is small-completeβΊ
lemma (in π΅) cat_small_complete_cat_Set: "cat_small_complete Ξ± (cat_Set Ξ±)"
proof(rule category.cat_small_complete_if_eq_and_obj_prod)
show "βE Ξ΅. Ξ΅ : E <β©Cβ©Fβ©.β©eβ©q (π,π,π€,π£) : βββ§2β©C β¦β¦β©CβΞ±β cat_Set Ξ±"
if "π£ : π β¦βcat_Set Ξ±β π" and "π€ : π β¦βcat_Set Ξ±β π" for π π π€ π£
using ntcf_Set_equalizer_2_is_cat_equalizer_2[OF that(2,1)] by auto
show "βP Ο. Ο : P <β©Cβ©Fβ©.β©β A : I β¦β¦β©CβΞ±β cat_Set Ξ±"
if "tm_cf_discrete Ξ± I A (cat_Set Ξ±)" for A I
proof(intro exI, rule tm_cf_discrete_ntcf_obj_prod_base_is_cat_obj_prod)
interpret tm_cf_discrete Ξ± I A βΉcat_Set Ξ±βΊ by (rule that)
show "VLambda I A ββ©β Vset Ξ±" by (rule tm_cf_discrete_ObjMap_in_Vset)
qed
qed (rule category_cat_Set)
textβΉ\newpageβΊ
endTheory CZH_UCAT_Adjoints
sectionβΉAdjointsβΊ
theory CZH_UCAT_Adjoints
imports
CZH_UCAT_Universal
CZH_Elementary_Categories.CZH_ECAT_Yoneda
begin
subsectionβΉBackgroundβΊ
named_theorems adj_cs_simps
named_theorems adj_cs_intros
named_theorems adj_field_simps
definition AdjLeft :: V where [adj_field_simps]: "AdjLeft = 0"
definition AdjRight :: V where [adj_field_simps]: "AdjRight = 1β©β"
definition AdjNT :: V where [adj_field_simps]: "AdjNT = 2β©β"
subsectionβΉDefinition and elementary propertiesβΊ
textβΉ
See subsection 2.1 in \cite{bodo_categories_1970} or Chapter IV-1 in
\cite{mac_lane_categories_2010}.
βΊ
locale is_cf_adjunction =
π΅ Ξ± +
vfsequence Ξ¦ +
L: category Ξ± β +
R: category Ξ± π +
LR: is_functor Ξ± β π π +
RL: is_functor Ξ± π β π +
NT: is_iso_ntcf
Ξ±
βΉop_cat β Γβ©C πβΊ
βΉcat_Set Ξ±βΊ
βΉHomβ©Oβ©.β©CβΞ±βπ(π-,-)βΊ
βΉHomβ©Oβ©.β©CβΞ±ββ(-,π-)βΊ
βΉΞ¦β¦AdjNTβ¦βΊ
for Ξ± β π π π Ξ¦ +
assumes cf_adj_length[adj_cs_simps]: "vcard Ξ¦ = 3β©β"
and cf_adj_AdjLeft[adj_cs_simps]: "Ξ¦β¦AdjLeftβ¦ = π"
and cf_adj_AdjRight[adj_cs_simps]: "Ξ¦β¦AdjRightβ¦ = π"
syntax "_is_cf_adjunction" :: "V β V β V β V β V β V β bool"
(βΉ(_ : _ ββ©Cβ©F _ : _ βββ©CΔ± _)βΊ [51, 51, 51, 51, 51] 51)
translations "Ξ¦ : π ββ©Cβ©F π : β βββ©CβΞ±β π" β
"CONST is_cf_adjunction Ξ± β π π π Ξ¦"
lemmas [adj_cs_simps] =
is_cf_adjunction.cf_adj_length
is_cf_adjunction.cf_adj_AdjLeft
is_cf_adjunction.cf_adj_AdjRight
textβΉComponents.βΊ
lemma cf_adjunction_components[adj_cs_simps]:
"[π, π, Ο]β©ββ¦AdjLeftβ¦ = π"
"[π, π, Ο]β©ββ¦AdjRightβ¦ = π"
"[π, π, Ο]β©ββ¦AdjNTβ¦ = Ο"
unfolding AdjLeft_def AdjRight_def AdjNT_def
by (simp_all add: nat_omega_simps)
textβΉRules.βΊ
lemma (in is_cf_adjunction) is_cf_adjunction_axioms'[adj_cs_intros]:
assumes "Ξ±' = Ξ±" and "β' = β" and "π' = π" and "π' = π" and "π' = π"
shows "Ξ¦ : π' ββ©Cβ©F π' : β' βββ©CβΞ±'β π'"
unfolding assms by (rule is_cf_adjunction_axioms)
lemmas (in is_cf_adjunction) [adj_cs_intros] = is_cf_adjunction_axioms
mk_ide rf is_cf_adjunction_def[unfolded is_cf_adjunction_axioms_def]
|intro is_cf_adjunctionI|
|dest is_cf_adjunctionD[dest]|
|elim is_cf_adjunctionE[elim]|
lemmas [adj_cs_intros] = is_cf_adjunctionD(3-6)
lemma (in is_cf_adjunction) cf_adj_is_iso_ntcf':
assumes "π' = Homβ©Oβ©.β©CβΞ±βπ(π-,-)"
and "π' = Homβ©Oβ©.β©CβΞ±ββ(-,π-)"
and "π' = op_cat β Γβ©C π"
and "π
' = cat_Set Ξ±"
shows "Ξ¦β¦AdjNTβ¦ : π' β¦β©Cβ©Fβ©.β©iβ©sβ©o π' : π' β¦β¦β©CβΞ±β π
'"
unfolding assms by (auto intro: cat_cs_intros)
lemmas [adj_cs_intros] = is_cf_adjunction.cf_adj_is_iso_ntcf'
lemma cf_adj_eqI:
assumes "Ξ¦ : π ββ©Cβ©F π : β βββ©CβΞ±β π"
and "Ξ¦' : π' ββ©Cβ©F π' : β' βββ©CβΞ±β π'"
and "β = β'"
and "π = π'"
and "π = π'"
and "π = π'"
and "Ξ¦β¦AdjNTβ¦ = Ξ¦'β¦AdjNTβ¦"
shows "Ξ¦ = Ξ¦'"
proof-
interpret Ξ¦: is_cf_adjunction Ξ± β π π π Ξ¦ by (rule assms(1))
interpret Ξ¦': is_cf_adjunction Ξ± β' π' π' π' Ξ¦' by (rule assms(2))
show ?thesis
proof(rule vsv_eqI)
have dom: "πβ©β Ξ¦ = 3β©β" by (cs_concl cs_simp: V_cs_simps adj_cs_simps)
show "πβ©β Ξ¦ = πβ©β Ξ¦'" by (cs_concl cs_simp: V_cs_simps adj_cs_simps dom)
from assms(4-7) have sup:
"Ξ¦β¦AdjLeftβ¦ = Ξ¦'β¦AdjLeftβ¦"
"Ξ¦β¦AdjRightβ¦ = Ξ¦'β¦AdjRightβ¦"
"Ξ¦β¦AdjNTβ¦ = Ξ¦'β¦AdjNTβ¦"
by (simp_all add: adj_cs_simps)
show "a ββ©β πβ©β Ξ¦ βΉ Ξ¦β¦aβ¦ = Ξ¦'β¦aβ¦" for a
by (unfold dom, elim_in_numeral, insert sup)
(auto simp: adj_field_simps)
qed (auto simp: Ξ¦.L.vsv_axioms Ξ¦'.vsv_axioms)
qed
subsectionβΉOpposite adjunctionβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉ
The following definition has the desired properties of the operation
of taking an opposite of an adjunction but helps to avoid dealing
with isomorphisms that arise in certain applications if the conventional
operation of taking the opposite is used instead.
βΊ
abbreviation op_cf_adj_nt :: "V β V β V β V"
where "op_cf_adj_nt β π Ο β‘ inv_ntcf (bnt_flip (op_cat β) π Ο)"
definition op_cf_adj :: "V β V"
where "op_cf_adj Ξ¦ =
[
op_cf (Ξ¦β¦AdjRightβ¦),
op_cf (Ξ¦β¦AdjLeftβ¦),
op_cf_adj_nt (Ξ¦β¦AdjLeftβ¦β¦HomDomβ¦) (Ξ¦β¦AdjLeftβ¦β¦HomCodβ¦) (Ξ¦β¦AdjNTβ¦)
]β©β"
lemma op_cf_adj_components:
shows "op_cf_adj Ξ¦β¦AdjLeftβ¦ = op_cf (Ξ¦β¦AdjRightβ¦)"
and "op_cf_adj Ξ¦β¦AdjRightβ¦ = op_cf (Ξ¦β¦AdjLeftβ¦)"
and "op_cf_adj Ξ¦β¦AdjNTβ¦ =
op_cf_adj_nt (Ξ¦β¦AdjLeftβ¦β¦HomDomβ¦) (Ξ¦β¦AdjLeftβ¦β¦HomCodβ¦) (Ξ¦β¦AdjNTβ¦)"
unfolding op_cf_adj_def adj_field_simps by (simp_all add: nat_omega_simps)
lemma (in is_cf_adjunction) op_cf_adj_components:
shows "op_cf_adj Ξ¦β¦AdjLeftβ¦ = op_cf π"
and "op_cf_adj Ξ¦β¦AdjRightβ¦ = op_cf π"
and "op_cf_adj Ξ¦β¦AdjNTβ¦ = inv_ntcf (bnt_flip (op_cat β) π (Ξ¦β¦AdjNTβ¦))"
unfolding op_cf_adj_components by (simp_all add: cat_cs_simps adj_cs_simps)
lemmas [cat_op_simps] = is_cf_adjunction.op_cf_adj_components
textβΉThe opposite adjunction is an adjunction.βΊ
lemma (in is_cf_adjunction) is_cf_adjunction_op:
"op_cf_adj Ξ¦ : op_cf π ββ©Cβ©F op_cf π : op_cat π βββ©CβΞ±β op_cat β"
proof(intro is_cf_adjunctionI, unfold cat_op_simps, unfold op_cf_adj_components)
show "vfsequence (op_cf_adj Ξ¦)" unfolding op_cf_adj_def by simp
show "vcard (op_cf_adj Ξ¦) = 3β©β"
unfolding op_cf_adj_def by (simp add: nat_omega_simps)
note adj = is_cf_adjunctionD[OF is_cf_adjunction_axioms]
from adj have f_Ο: "bnt_flip (op_cat β) π (Ξ¦β¦AdjNTβ¦) :
Homβ©Oβ©.β©CβΞ±βop_cat π(-,op_cf π-) β¦β©Cβ©Fβ©.β©iβ©sβ©o Homβ©Oβ©.β©CβΞ±βop_cat β(op_cf π-,-) :
π Γβ©C op_cat β β¦β¦β©CβΞ±β cat_Set Ξ±"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)
show "op_cf_adj_nt β π (Ξ¦β¦AdjNTβ¦) :
Homβ©Oβ©.β©CβΞ±βop_cat β(op_cf π-,-) β¦β©Cβ©Fβ©.β©iβ©sβ©o Homβ©Oβ©.β©CβΞ±βop_cat π(-,op_cf π-) :
π Γβ©C op_cat β β¦β¦β©CβΞ±β cat_Set Ξ±"
by (rule CZH_ECAT_NTCF.iso_ntcf_is_arr_isomorphism(1)[OF f_Ο])
qed (auto intro: cat_cs_intros cat_op_intros)
lemmas is_cf_adjunction_op =
is_cf_adjunction.is_cf_adjunction_op
lemma (in is_cf_adjunction) is_cf_adjunction_op'[cat_op_intros]:
assumes "π' = op_cf π"
and "π' = op_cf π"
and "π' = op_cat π"
and "β' = op_cat β"
shows "op_cf_adj Ξ¦ : π' ββ©Cβ©F π' : π' βββ©CβΞ±β β'"
unfolding assms by (rule is_cf_adjunction_op)
lemmas [cat_op_intros] = is_cf_adjunction.is_cf_adjunction_op'
textβΉThe operation of taking the opposite adjunction is an involution.βΊ
lemma (in is_cf_adjunction) cf_adjunction_op_cf_adj_op_cf_adj[cat_op_simps]:
"op_cf_adj (op_cf_adj Ξ¦) = Ξ¦"
proof(rule cf_adj_eqI)
show Ξ¦': "op_cf_adj (op_cf_adj Ξ¦) : π ββ©Cβ©F π : β βββ©CβΞ±β π"
proof(intro is_cf_adjunctionI)
show "vfsequence (op_cf_adj (op_cf_adj Ξ¦))" unfolding op_cf_adj_def by simp
from is_cf_adjunction_axioms show "op_cf_adj (op_cf_adj Ξ¦)β¦AdjNTβ¦ :
Homβ©Oβ©.β©CβΞ±βπ(π-,-) β¦β©Cβ©Fβ©.β©iβ©sβ©o Homβ©Oβ©.β©CβΞ±ββ(-,π-) :
op_cat β Γβ©C π β¦β¦β©CβΞ±β cat_Set Ξ±"
by
(
cs_concl cs_ist_simple
cs_intro: cat_cs_intros cat_op_intros adj_cs_intros
cs_simp: cat_cs_simps cat_op_simps
)
show "vcard (op_cf_adj (op_cf_adj Ξ¦)) = 3β©β"
unfolding op_cf_adj_def by (simp add: nat_omega_simps)
from is_cf_adjunction_axioms show "op_cf_adj (op_cf_adj Ξ¦)β¦AdjLeftβ¦ = π"
by (cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)
from is_cf_adjunction_axioms show "op_cf_adj (op_cf_adj Ξ¦)β¦AdjRightβ¦ = π"
by (cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)
qed (auto intro: cat_cs_intros)
interpret Ξ¦': is_cf_adjunction Ξ± β π π π βΉop_cf_adj (op_cf_adj Ξ¦)βΊ
by (rule Ξ¦')
show "op_cf_adj (op_cf_adj Ξ¦)β¦AdjNTβ¦ = Ξ¦β¦AdjNTβ¦"
proof(rule ntcf_eqI)
show op_op_Ξ¦:
"op_cf_adj (op_cf_adj Ξ¦)β¦AdjNTβ¦ :
Homβ©Oβ©.β©CβΞ±βπ(π-,-) β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±ββ(-,π-) :
op_cat β Γβ©C π β¦β¦β©CβΞ±β cat_Set Ξ±"
by (rule Ξ¦'.NT.is_ntcf_axioms)
show Ξ¦: "Ξ¦β¦AdjNTβ¦ :
Homβ©Oβ©.β©CβΞ±βπ(π-,-) β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±ββ(-,π-) :
op_cat β Γβ©C π β¦β¦β©CβΞ±β cat_Set Ξ±"
by (rule NT.is_ntcf_axioms)
from op_op_Ξ¦ have dom_lhs:
"πβ©β (op_cf_adj (op_cf_adj Ξ¦)β¦AdjNTβ¦β¦NTMapβ¦) = (op_cat β Γβ©C π)β¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps)
show "op_cf_adj (op_cf_adj Ξ¦)β¦AdjNTβ¦β¦NTMapβ¦ = Ξ¦β¦AdjNTβ¦β¦NTMapβ¦"
proof(rule vsv_eqI, unfold NT.ntcf_NTMap_vdomain dom_lhs)
fix cd assume prems: "cd ββ©β (op_cat β Γβ©C π)β¦Objβ¦"
then obtain c d
where cd_def: "cd = [c, d]β©β"
and c: "c ββ©β op_cat ββ¦Objβ¦"
and d: "d ββ©β πβ¦Objβ¦"
by (elim cat_prod_2_ObjE[OF L.category_op R.category_axioms prems])
from is_cf_adjunction_axioms c d L.category_axioms R.category_axioms Ξ¦
show
"op_cf_adj (op_cf_adj Ξ¦)β¦AdjNTβ¦β¦NTMapβ¦β¦cdβ¦ = Ξ¦β¦AdjNTβ¦β¦NTMapβ¦β¦cdβ¦"
unfolding cd_def cat_op_simps
by
(
cs_concl
cs_intro:
cat_arrow_cs_intros
ntcf_cs_intros
adj_cs_intros
cat_op_intros
cat_cs_intros
cat_prod_cs_intros
cs_simp: cat_cs_simps cat_op_simps
)
qed (auto intro: inv_ntcf_NTMap_vsv)
qed simp_all
qed (auto intro: adj_cs_intros)
lemmas [cat_op_simps] = is_cf_adjunction.cf_adjunction_op_cf_adj_op_cf_adj
subsubsectionβΉAlternative form of the naturality conditionβΊ
textβΉ
The lemmas in this subsection are based on the comments on page 81 in
\cite{mac_lane_categories_2010}.
βΊ
lemma (in is_cf_adjunction) cf_adj_Comp_commute_RL:
assumes "x ββ©β ββ¦Objβ¦"
and "f : πβ¦ObjMapβ¦β¦xβ¦ β¦βπβ a"
and "k : a β¦βπβ a'"
shows
"πβ¦ArrMapβ¦β¦kβ¦ ββ©Aβββ (Ξ¦β¦AdjNTβ¦β¦NTMapβ¦β¦x, aβ¦β©β)β¦ArrValβ¦β¦fβ¦ =
(Ξ¦β¦AdjNTβ¦β¦NTMapβ¦β¦x, a'β¦β©β)β¦ArrValβ¦β¦k ββ©Aβπβ fβ¦"
proof-
from
assms
is_cf_adjunction_axioms
L.category_axioms R.category_axioms
L.category_op R.category_op
have Ο_x_a: "Ξ¦β¦AdjNTβ¦β¦NTMapβ¦β¦x, aβ¦β©β :
Hom π (πβ¦ObjMapβ¦β¦xβ¦) a β¦βcat_Set Ξ±β Hom β x (πβ¦ObjMapβ¦β¦aβ¦)"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
)
note Ο_x_a_f =
cat_Set_ArrVal_app_vrange[OF Ο_x_a, unfolded in_Hom_iff, OF assms(2)]
from
is_cf_adjunction_axioms assms
L.category_axioms R.category_axioms
L.category_op R.category_op
have Ο_x_a':
"Ξ¦β¦AdjNTβ¦β¦NTMapβ¦β¦x, a'β¦β©β :
Hom π (πβ¦ObjMapβ¦β¦xβ¦) a' β¦βcat_Set Ξ±β Hom β x (πβ¦ObjMapβ¦β¦a'β¦)"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
)
from is_cf_adjunction_axioms this assms have x_k:
"[ββ¦CIdβ¦β¦xβ¦, k]β©β : [x, a]β©β β¦βop_cat β Γβ©C πβ [x, a']β©β"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
)
from
NT.ntcf_Comp_commute[OF this] is_cf_adjunction_axioms assms
L.category_axioms R.category_axioms
L.category_op R.category_op
have
"Ξ¦β¦AdjNTβ¦β¦NTMapβ¦β¦x, a'β¦β©β ββ©Aβcat_Set Ξ±β cf_hom π [πβ¦CIdβ¦β¦πβ¦ObjMapβ¦β¦xβ¦β¦, k]β©β =
cf_hom β [ββ¦CIdβ¦β¦xβ¦, πβ¦ArrMapβ¦β¦kβ¦]β©β ββ©Aβcat_Set Ξ±β Ξ¦β¦AdjNTβ¦β¦NTMapβ¦β¦x, aβ¦β©β"
(is βΉ?lhs = ?rhsβΊ)
by
(
cs_prems cs_ist_simple
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
)
moreover from
is_cf_adjunction_axioms assms Ο_x_a'
L.category_axioms R.category_axioms
L.category_op R.category_op
have
"?lhsβ¦ArrValβ¦β¦fβ¦ = (Ξ¦β¦AdjNTβ¦β¦NTMapβ¦β¦x, a'β¦β©β)β¦ArrValβ¦β¦k ββ©Aβπβ fβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
)
moreover from
is_cf_adjunction_axioms assms Ο_x_a_f
L.category_axioms R.category_axioms
L.category_op R.category_op
have
"?rhsβ¦ArrValβ¦β¦fβ¦ = πβ¦ArrMapβ¦β¦kβ¦ ββ©Aβββ (Ξ¦β¦AdjNTβ¦β¦NTMapβ¦β¦x, aβ¦β©β)β¦ArrValβ¦β¦fβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
)
ultimately show ?thesis by simp
qed
lemma (in is_cf_adjunction) cf_adj_Comp_commute_LR:
assumes "x ββ©β ββ¦Objβ¦"
and "f : πβ¦ObjMapβ¦β¦xβ¦ β¦βπβ a"
and "h : x' β¦βββ x"
shows
"(Ξ¦β¦AdjNTβ¦β¦NTMapβ¦β¦x, aβ¦β©β)β¦ArrValβ¦β¦fβ¦ ββ©Aβββ h =
(Ξ¦β¦AdjNTβ¦β¦NTMapβ¦β¦x', aβ¦β©β)β¦ArrValβ¦β¦f ββ©Aβπβ πβ¦ArrMapβ¦β¦hβ¦β¦"
proof-
from
is_cf_adjunction_axioms assms
L.category_axioms R.category_axioms
L.category_op R.category_op
have Ο_x_a: "Ξ¦β¦AdjNTβ¦β¦NTMapβ¦β¦x, aβ¦β©β :
Hom π (πβ¦ObjMapβ¦β¦xβ¦) a β¦βcat_Set Ξ±β Hom β x (πβ¦ObjMapβ¦β¦aβ¦)"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
)
note Ο_x_a_f =
cat_Set_ArrVal_app_vrange[OF Ο_x_a, unfolded in_Hom_iff, OF assms(2)]
from is_cf_adjunction_axioms assms have
"[h, πβ¦CIdβ¦β¦aβ¦]β©β : [x, a]β©β β¦βop_cat β Γβ©C πβ [x', a]β©β"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
)
from
NT.ntcf_Comp_commute[OF this] is_cf_adjunction_axioms assms
L.category_axioms R.category_axioms
L.category_op R.category_op
have
"Ξ¦β¦AdjNTβ¦β¦NTMapβ¦β¦x', aβ¦β©β ββ©Aβcat_Set Ξ±β cf_hom π [πβ¦ArrMapβ¦β¦hβ¦, πβ¦CIdβ¦β¦aβ¦]β©β =
cf_hom β [h, ββ¦CIdβ¦β¦πβ¦ObjMapβ¦β¦aβ¦β¦]β©β ββ©Aβcat_Set Ξ±β Ξ¦β¦AdjNTβ¦β¦NTMapβ¦β¦x, aβ¦β©β"
(is βΉ?lhs = ?rhsβΊ)
by
(
cs_prems
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
)
moreover from
is_cf_adjunction_axioms assms
L.category_axioms R.category_axioms
L.category_op R.category_op
have
"?lhsβ¦ArrValβ¦β¦fβ¦ = (Ξ¦β¦AdjNTβ¦β¦NTMapβ¦β¦x', aβ¦β©β)β¦ArrValβ¦β¦f ββ©Aβπβ πβ¦ArrMapβ¦β¦hβ¦β¦"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
)
moreover from
is_cf_adjunction_axioms assms Ο_x_a_f
L.category_axioms R.category_axioms
L.category_op R.category_op
have
"?rhsβ¦ArrValβ¦β¦fβ¦ = (Ξ¦β¦AdjNTβ¦β¦NTMapβ¦β¦x, aβ¦β©β)β¦ArrValβ¦β¦fβ¦ ββ©Aβββ h"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
)
ultimately show ?thesis by simp
qed
subsectionβΉUnitβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉSee Chapter IV-1 in \cite{mac_lane_categories_2010}.βΊ
definition cf_adjunction_unit :: "V β V" (βΉΞ·β©CβΊ)
where "Ξ·β©C Ξ¦ =
[
(
Ξ»xββ©βΞ¦β¦AdjLeftβ¦β¦HomDomβ¦β¦Objβ¦.
(Ξ¦β¦AdjNTβ¦β¦NTMapβ¦β¦x, Ξ¦β¦AdjLeftβ¦β¦ObjMapβ¦β¦xβ¦β¦β©β)β¦ArrValβ¦β¦
Ξ¦β¦AdjLeftβ¦β¦HomCodβ¦β¦CIdβ¦β¦Ξ¦β¦AdjLeftβ¦β¦ObjMapβ¦β¦xβ¦β¦
β¦
),
cf_id (Ξ¦β¦AdjLeftβ¦β¦HomDomβ¦),
(Ξ¦β¦AdjRightβ¦) ββ©Cβ©F (Ξ¦β¦AdjLeftβ¦),
Ξ¦β¦AdjLeftβ¦β¦HomDomβ¦,
Ξ¦β¦AdjLeftβ¦β¦HomDomβ¦
]β©β"
textβΉComponents.βΊ
lemma cf_adjunction_unit_components:
shows "Ξ·β©C Ξ¦β¦NTMapβ¦ =
(
Ξ»xββ©βΞ¦β¦AdjLeftβ¦β¦HomDomβ¦β¦Objβ¦.
(Ξ¦β¦AdjNTβ¦β¦NTMapβ¦β¦x, Ξ¦β¦AdjLeftβ¦β¦ObjMapβ¦β¦xβ¦β¦β©β)β¦ArrValβ¦β¦
Ξ¦β¦AdjLeftβ¦β¦HomCodβ¦β¦CIdβ¦β¦Ξ¦β¦AdjLeftβ¦β¦ObjMapβ¦β¦xβ¦β¦
β¦
)"
and "Ξ·β©C Ξ¦β¦NTDomβ¦ = cf_id (Ξ¦β¦AdjLeftβ¦β¦HomDomβ¦)"
and "Ξ·β©C Ξ¦β¦NTCodβ¦ = (Ξ¦β¦AdjRightβ¦) ββ©Cβ©F (Ξ¦β¦AdjLeftβ¦)"
and "Ξ·β©C Ξ¦β¦NTDGDomβ¦ = Ξ¦β¦AdjLeftβ¦β¦HomDomβ¦"
and "Ξ·β©C Ξ¦β¦NTDGCodβ¦ = Ξ¦β¦AdjLeftβ¦β¦HomDomβ¦"
unfolding cf_adjunction_unit_def nt_field_simps
by (simp_all add: nat_omega_simps)
context is_cf_adjunction
begin
lemma cf_adjunction_unit_components':
shows "Ξ·β©C Ξ¦β¦NTMapβ¦ =
(
Ξ»xββ©βββ¦Objβ¦.
(Ξ¦β¦AdjNTβ¦β¦NTMapβ¦β¦x, πβ¦ObjMapβ¦β¦xβ¦β¦β©β)β¦ArrValβ¦β¦πβ¦CIdβ¦β¦πβ¦ObjMapβ¦β¦xβ¦β¦β¦
)"
and "Ξ·β©C Ξ¦β¦NTDomβ¦ = cf_id β"
and "Ξ·β©C Ξ¦β¦NTCodβ¦ = π ββ©Cβ©F π"
and "Ξ·β©C Ξ¦β¦NTDGDomβ¦ = β"
and "Ξ·β©C Ξ¦β¦NTDGCodβ¦ = β"
unfolding cf_adjunction_unit_components
by (cs_concl cs_simp: cat_cs_simps adj_cs_simps)+
mk_VLambda cf_adjunction_unit_components'(1)
|vdomain cf_adjunction_unit_NTMap_vdomain[adj_cs_simps]|
|app cf_adjunction_unit_NTMap_app[adj_cs_simps]|
end
mk_VLambda cf_adjunction_unit_components(1)
|vsv cf_adjunction_unit_NTMap_vsv[adj_cs_intros]|
lemmas [adj_cs_simps] =
is_cf_adjunction.cf_adjunction_unit_NTMap_vdomain
is_cf_adjunction.cf_adjunction_unit_NTMap_app
subsubsectionβΉNatural transformation mapβΊ
lemma (in is_cf_adjunction) cf_adjunction_unit_NTMap_is_arr:
assumes "x ββ©β ββ¦Objβ¦"
shows "Ξ·β©C Ξ¦β¦NTMapβ¦β¦xβ¦ : x β¦βββ πβ¦ObjMapβ¦β¦πβ¦ObjMapβ¦β¦xβ¦β¦"
proof-
from
is_cf_adjunction_axioms assms
L.category_axioms R.category_axioms
L.category_op R.category_op
have Ο_x_πx:
"Ξ¦β¦AdjNTβ¦β¦NTMapβ¦β¦x, πβ¦ObjMapβ¦β¦xβ¦β¦β©β :
Hom π (πβ¦ObjMapβ¦β¦xβ¦) (πβ¦ObjMapβ¦β¦xβ¦) β¦βcat_Set Ξ±β
Hom β x (πβ¦ObjMapβ¦β¦πβ¦ObjMapβ¦β¦xβ¦β¦)"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
)
from is_cf_adjunction_axioms assms have CId_πx:
"πβ¦CIdβ¦β¦πβ¦ObjMapβ¦β¦xβ¦β¦ : πβ¦ObjMapβ¦β¦xβ¦ β¦βπβ πβ¦ObjMapβ¦β¦xβ¦"
by (cs_concl cs_simp: cs_intro: cat_cs_intros adj_cs_intros)
from
is_cf_adjunction_axioms
assms
cat_Set_ArrVal_app_vrange[OF Ο_x_πx, unfolded in_Hom_iff, OF CId_πx]
show "Ξ·β©C Ξ¦β¦NTMapβ¦β¦xβ¦ : x β¦βββ πβ¦ObjMapβ¦β¦πβ¦ObjMapβ¦β¦xβ¦β¦"
by (cs_concl cs_simp: adj_cs_simps cs_intro: cat_cs_intros)
qed
lemma (in is_cf_adjunction) cf_adjunction_unit_NTMap_is_arr':
assumes "x ββ©β ββ¦Objβ¦"
and "a = x"
and "b = πβ¦ObjMapβ¦β¦πβ¦ObjMapβ¦β¦xβ¦β¦"
and "β' = β"
shows "Ξ·β©C Ξ¦β¦NTMapβ¦β¦xβ¦ : x β¦ββ'β b"
using assms(1) unfolding assms(2-4) by (rule cf_adjunction_unit_NTMap_is_arr)
lemmas [adj_cs_intros] = is_cf_adjunction.cf_adjunction_unit_NTMap_is_arr'
lemma (in is_cf_adjunction) cf_adjunction_unit_NTMap_vrange:
"ββ©β (Ξ·β©C Ξ¦β¦NTMapβ¦) ββ©β ββ¦Arrβ¦"
proof(rule vsv.vsv_vrange_vsubset, unfold cf_adjunction_unit_NTMap_vdomain)
fix x assume prems: "x ββ©β ββ¦Objβ¦"
from cf_adjunction_unit_NTMap_is_arr[OF prems] show "Ξ·β©C Ξ¦β¦NTMapβ¦β¦xβ¦ ββ©β ββ¦Arrβ¦"
by auto
qed (auto intro: adj_cs_intros)
subsubsectionβΉUnit is a natural transformationβΊ
lemma (in is_cf_adjunction) cf_adjunction_unit_is_ntcf:
"Ξ·β©C Ξ¦ : cf_id β β¦β©Cβ©F π ββ©Cβ©F π : β β¦β¦β©CβΞ±β β"
proof(intro is_ntcfI')
show "vfsequence (Ξ·β©C Ξ¦)" unfolding cf_adjunction_unit_def by simp
show "vcard (Ξ·β©C Ξ¦) = 5β©β"
unfolding cf_adjunction_unit_def by (simp add: nat_omega_simps)
from is_cf_adjunction_axioms show "cf_id β : β β¦β¦β©CβΞ±β β"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros adj_cs_intros)
from is_cf_adjunction_axioms show "π ββ©Cβ©F π : β β¦β¦β©CβΞ±β β"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros adj_cs_intros)
from is_cf_adjunction_axioms show "πβ©β (Ξ·β©C Ξ¦β¦NTMapβ¦) = ββ¦Objβ¦"
by (cs_concl cs_simp: adj_cs_simps cs_intro: cat_cs_intros)
show "Ξ·β©C Ξ¦β¦NTMapβ¦β¦aβ¦ : cf_id ββ¦ObjMapβ¦β¦aβ¦ β¦βββ (π ββ©Cβ©F π)β¦ObjMapβ¦β¦aβ¦"
if "a ββ©β ββ¦Objβ¦" for a
using is_cf_adjunction_axioms that
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros adj_cs_intros)
show
"Ξ·β©C Ξ¦β¦NTMapβ¦β¦bβ¦ ββ©Aβββ cf_id ββ¦ArrMapβ¦β¦fβ¦ =
(π ββ©Cβ©F π)β¦ArrMapβ¦β¦fβ¦ ββ©Aβββ Ξ·β©C Ξ¦β¦NTMapβ¦β¦aβ¦"
if "f : a β¦βββ b" for a b f
using is_cf_adjunction_axioms that
by
(
cs_concl
cs_simp:
cf_adj_Comp_commute_RL cf_adj_Comp_commute_LR
cat_cs_simps
adj_cs_simps
cs_intro: cat_cs_intros adj_cs_intros
)
qed (auto simp: cf_adjunction_unit_components')
lemma (in is_cf_adjunction) cf_adjunction_unit_is_ntcf':
assumes "π = cf_id β"
and "π' = π ββ©Cβ©F π"
and "π = β"
and "π
= β"
shows "Ξ·β©C Ξ¦ : π β¦β©Cβ©F π' : π β¦β¦β©CβΞ±β π
"
unfolding assms by (rule cf_adjunction_unit_is_ntcf)
lemmas [adj_cs_intros] = is_cf_adjunction.cf_adjunction_unit_is_ntcf'
subsubsectionβΉEvery component of a unit is a universal arrowβΊ
textβΉ
The lemmas in this subsection are based on elements of the statement of
Theorem 1 in Chapter IV-1 in \cite{mac_lane_categories_2010}.
βΊ
lemma (in is_cf_adjunction) cf_adj_umap_of_unit:
assumes "x ββ©β ββ¦Objβ¦" and "a ββ©β πβ¦Objβ¦"
shows "Ξ¦β¦AdjNTβ¦β¦NTMapβ¦β¦x, aβ¦β©β =
umap_of π x (πβ¦ObjMapβ¦β¦xβ¦) (Ξ·β©C Ξ¦β¦NTMapβ¦β¦xβ¦) a"
(is βΉΞ¦β¦AdjNTβ¦β¦NTMapβ¦β¦x, aβ¦β©β = ?uof_aβΊ)
proof-
from
is_cf_adjunction_axioms assms
L.category_axioms R.category_axioms
L.category_op R.category_op
have Ο_xa: "Ξ¦β¦AdjNTβ¦β¦NTMapβ¦β¦x, aβ¦β©β :
Hom π (πβ¦ObjMapβ¦β¦xβ¦) a β¦βcat_Set Ξ±β Hom β x (πβ¦ObjMapβ¦β¦aβ¦)"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
)
then have dom_lhs:
"πβ©β ((Ξ¦β¦AdjNTβ¦β¦NTMapβ¦β¦x, aβ¦β©β)β¦ArrValβ¦) = Hom π (πβ¦ObjMapβ¦β¦xβ¦) a"
by (cs_concl cs_simp: cat_cs_simps)
from is_cf_adjunction_axioms assms have uof_a:
"?uof_a : Hom π (πβ¦ObjMapβ¦β¦xβ¦) a β¦βcat_Set Ξ±β Hom β x (πβ¦ObjMapβ¦β¦aβ¦)"
by (cs_concl cs_simp: cs_intro: cat_cs_intros adj_cs_intros)
then have dom_rhs: "πβ©β (?uof_aβ¦ArrValβ¦) = Hom π (πβ¦ObjMapβ¦β¦xβ¦) a"
by (cs_concl cs_simp: cat_cs_simps)
show ?thesis
proof(rule arr_Set_eqI[of Ξ±])
from Ο_xa show arr_Set_Ο_xa: "arr_Set Ξ± (Ξ¦β¦AdjNTβ¦β¦NTMapβ¦β¦x, aβ¦β©β)"
by (auto dest: cat_Set_is_arrD(1))
from uof_a show arr_Set_uof_a: "arr_Set Ξ± ?uof_a"
by (auto dest: cat_Set_is_arrD(1))
show "(Ξ¦β¦AdjNTβ¦β¦NTMapβ¦β¦x, aβ¦β©β)β¦ArrValβ¦ = ?uof_aβ¦ArrValβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
fix g assume prems: "g : πβ¦ObjMapβ¦β¦xβ¦ β¦βπβ a"
from is_cf_adjunction_axioms assms prems show
"(Ξ¦β¦AdjNTβ¦β¦NTMapβ¦β¦x, aβ¦β©β)β¦ArrValβ¦β¦gβ¦ = ?uof_aβ¦ArrValβ¦β¦gβ¦"
by
(
cs_concl
cs_simp:
cf_adj_Comp_commute_RL
adj_cs_simps
cat_cs_simps
cat_op_simps
cat_prod_cs_simps
cs_intro:
adj_cs_intros
ntcf_cs_intros
cat_cs_intros
cat_op_intros
cat_prod_cs_intros
)
qed (use arr_Set_Ο_xa arr_Set_uof_a in auto)
qed (use Ο_xa uof_a in βΉcs_concl cs_simp: cat_cs_simpsβΊ)+
qed
lemma (in is_cf_adjunction) cf_adj_umap_of_unit':
assumes "x ββ©β ββ¦Objβ¦"
and "a ββ©β πβ¦Objβ¦"
and "Ξ· = Ξ·β©C Ξ¦β¦NTMapβ¦β¦xβ¦"
and "πx = πβ¦ObjMapβ¦β¦xβ¦"
shows "Ξ¦β¦AdjNTβ¦β¦NTMapβ¦β¦x, aβ¦β©β = umap_of π x πx Ξ· a"
using assms(1,2) unfolding assms(3,4) by (rule cf_adj_umap_of_unit)
lemma (in is_cf_adjunction) cf_adjunction_unit_component_is_ua_of:
assumes "x ββ©β ββ¦Objβ¦"
shows "universal_arrow_of π x (πβ¦ObjMapβ¦β¦xβ¦) (Ξ·β©C Ξ¦β¦NTMapβ¦β¦xβ¦)"
(is βΉuniversal_arrow_of π x (πβ¦ObjMapβ¦β¦xβ¦) ?Ξ·xβΊ)
proof(rule RL.cf_ua_of_if_ntcf_ua_of_is_iso_ntcf)
from is_cf_adjunction_axioms assms show "πβ¦ObjMapβ¦β¦xβ¦ ββ©β πβ¦Objβ¦"
by (cs_concl cs_intro: cat_cs_intros adj_cs_intros)
from is_cf_adjunction_axioms assms show
"Ξ·β©C Ξ¦β¦NTMapβ¦β¦xβ¦ : x β¦βββ πβ¦ObjMapβ¦β¦πβ¦ObjMapβ¦β¦xβ¦β¦"
by (cs_concl cs_simp: cs_intro: cat_cs_intros adj_cs_intros)
show
"ntcf_ua_of Ξ± π x (πβ¦ObjMapβ¦β¦xβ¦) (Ξ·β©C Ξ¦β¦NTMapβ¦β¦xβ¦) :
Homβ©Oβ©.β©CβΞ±βπ(πβ¦ObjMapβ¦β¦xβ¦,-) β¦β©Cβ©Fβ©.β©iβ©sβ©o Homβ©Oβ©.β©CβΞ±ββ(x,-) ββ©Cβ©F π :
π β¦β¦β©CβΞ±β cat_Set Ξ±"
(is βΉ?ntcf_ua_of : ?Hπ β¦β©Cβ©Fβ©.β©iβ©sβ©o ?Hπ : π β¦β¦β©CβΞ±β cat_Set Ξ±βΊ)
proof(rule is_iso_ntcfI)
from is_cf_adjunction_axioms assms show
"?ntcf_ua_of : ?Hπ β¦β©Cβ©F ?Hπ : π β¦β¦β©CβΞ±β cat_Set Ξ±"
by (intro RL.cf_ntcf_ua_of_is_ntcf)
(cs_concl cs_simp: cs_intro: cat_cs_intros adj_cs_intros)+
fix a assume prems: "a ββ©β πβ¦Objβ¦"
from assms prems have
"Ξ¦β¦AdjNTβ¦β¦NTMapβ¦β¦x, aβ¦β©β = umap_of π x (πβ¦ObjMapβ¦β¦xβ¦) ?Ξ·x a"
(is βΉΞ¦β¦AdjNTβ¦β¦NTMapβ¦β¦x, aβ¦β©β = ?uof_aβΊ)
by (rule cf_adj_umap_of_unit)
from assms prems L.category_axioms R.category_axioms have
"[x, a]β©β ββ©β (op_cat β Γβ©C π)β¦Objβ¦"
by (cs_concl cs_simp: cs_intro: cat_op_intros cat_prod_cs_intros)
from
NT.iso_ntcf_is_arr_isomorphism[
OF this, unfolded cf_adj_umap_of_unit[OF assms prems]
]
is_cf_adjunction_axioms assms prems
L.category_axioms R.category_axioms
have "?uof_a :
Hom π (πβ¦ObjMapβ¦β¦xβ¦) a β¦β©iβ©sβ©oβcat_Set Ξ±β Hom β x (πβ¦ObjMapβ¦β¦aβ¦)"
by
(
cs_prems
cs_simp: cat_cs_simps
cs_intro:
cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
)
with is_cf_adjunction_axioms assms prems show
"?ntcf_ua_ofβ¦NTMapβ¦β¦aβ¦ : ?Hπβ¦ObjMapβ¦β¦aβ¦ β¦β©iβ©sβ©oβcat_Set Ξ±β ?Hπβ¦ObjMapβ¦β¦aβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros adj_cs_intros
)
qed
qed
subsectionβΉCounitβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition cf_adjunction_counit :: "V β V" (βΉΞ΅β©CβΊ)
where "Ξ΅β©C Ξ¦ =
[
(
Ξ»xββ©βΞ¦β¦AdjLeftβ¦β¦HomCodβ¦β¦Objβ¦.
(Ξ¦β¦AdjNTβ¦β¦NTMapβ¦β¦Ξ¦β¦AdjRightβ¦β¦ObjMapβ¦β¦xβ¦, xβ¦β©β)Β―β©Sβ©eβ©tβ¦ArrValβ¦β¦
Ξ¦β¦AdjLeftβ¦β¦HomDomβ¦β¦CIdβ¦β¦Ξ¦β¦AdjRightβ¦β¦ObjMapβ¦β¦xβ¦β¦
β¦
),
(Ξ¦β¦AdjLeftβ¦) ββ©Cβ©F (Ξ¦β¦AdjRightβ¦),
cf_id (Ξ¦β¦AdjLeftβ¦β¦HomCodβ¦),
Ξ¦β¦AdjLeftβ¦β¦HomCodβ¦,
Ξ¦β¦AdjLeftβ¦β¦HomCodβ¦
]β©β"
textβΉComponents.βΊ
lemma cf_adjunction_counit_components:
shows "Ξ΅β©C Ξ¦β¦NTMapβ¦ =
(
Ξ»xββ©βΞ¦β¦AdjLeftβ¦β¦HomCodβ¦β¦Objβ¦.
(Ξ¦β¦AdjNTβ¦β¦NTMapβ¦β¦Ξ¦β¦AdjRightβ¦β¦ObjMapβ¦β¦xβ¦, xβ¦β©β)Β―β©Sβ©eβ©tβ¦ArrValβ¦β¦
Ξ¦β¦AdjLeftβ¦β¦HomDomβ¦β¦CIdβ¦β¦Ξ¦β¦AdjRightβ¦β¦ObjMapβ¦β¦xβ¦β¦
β¦
)"
and "Ξ΅β©C Ξ¦β¦NTDomβ¦ = (Ξ¦β¦AdjLeftβ¦) ββ©Cβ©F (Ξ¦β¦AdjRightβ¦)"
and "Ξ΅β©C Ξ¦β¦NTCodβ¦ = cf_id (Ξ¦β¦AdjLeftβ¦β¦HomCodβ¦)"
and "Ξ΅β©C Ξ¦β¦NTDGDomβ¦ = Ξ¦β¦AdjLeftβ¦β¦HomCodβ¦"
and "Ξ΅β©C Ξ¦β¦NTDGCodβ¦ = Ξ¦β¦AdjLeftβ¦β¦HomCodβ¦"
unfolding cf_adjunction_counit_def nt_field_simps
by (simp_all add: nat_omega_simps)
context is_cf_adjunction
begin
lemma cf_adjunction_counit_components':
shows "Ξ΅β©C Ξ¦β¦NTMapβ¦ =
(
Ξ»xββ©βπβ¦Objβ¦.
(Ξ¦β¦AdjNTβ¦β¦NTMapβ¦β¦πβ¦ObjMapβ¦β¦xβ¦, xβ¦β©β)Β―β©Sβ©eβ©tβ¦ArrValβ¦β¦ββ¦CIdβ¦β¦πβ¦ObjMapβ¦β¦xβ¦β¦β¦
)"
and "Ξ΅β©C Ξ¦β¦NTDomβ¦ = π ββ©Cβ©F π"
and "Ξ΅β©C Ξ¦β¦NTCodβ¦ = cf_id π"
and "Ξ΅β©C Ξ¦β¦NTDGDomβ¦ = π"
and "Ξ΅β©C Ξ¦β¦NTDGCodβ¦ = π"
unfolding cf_adjunction_counit_components
by (cs_concl cs_simp: cat_cs_simps adj_cs_simps)+
mk_VLambda cf_adjunction_counit_components'(1)
|vdomain cf_adjunction_counit_NTMap_vdomain[adj_cs_simps]|
|app cf_adjunction_counit_NTMap_app[adj_cs_simps]|
end
mk_VLambda cf_adjunction_counit_components(1)
|vsv cf_adjunction_counit_NTMap_vsv[adj_cs_intros]|
lemmas [adj_cs_simps] =
is_cf_adjunction.cf_adjunction_counit_NTMap_vdomain
is_cf_adjunction.cf_adjunction_counit_NTMap_app
subsubsectionβΉDuality for the unit and counitβΊ
lemma (in is_cf_adjunction) cf_adjunction_unit_NTMap_op:
"Ξ·β©C (op_cf_adj Ξ¦)β¦NTMapβ¦ = Ξ΅β©C Ξ¦β¦NTMapβ¦"
proof-
interpret op_Ξ¦:
is_cf_adjunction Ξ± βΉop_cat πβΊ βΉop_cat ββΊ βΉop_cf πβΊ βΉop_cf πβΊ βΉop_cf_adj Ξ¦βΊ
by (rule is_cf_adjunction_op)
show ?thesis
proof
(
rule vsv_eqI,
unfold
cf_adjunction_counit_NTMap_vdomain
op_Ξ¦.cf_adjunction_unit_NTMap_vdomain
)
fix a assume prems: "a ββ©β op_cat πβ¦Objβ¦"
then have a: "a ββ©β πβ¦Objβ¦" unfolding cat_op_simps by simp
from is_cf_adjunction_axioms a show
"Ξ·β©C (op_cf_adj Ξ¦)β¦NTMapβ¦β¦aβ¦ = Ξ΅β©C Ξ¦β¦NTMapβ¦β¦aβ¦"
by
(
cs_concl
cs_simp: cat_Set_cs_simps cat_cs_simps cat_op_simps adj_cs_simps
cs_intro:
cat_arrow_cs_intros cat_cs_intros cat_op_intros cat_prod_cs_intros
)
qed
(
simp_all add:
cat_op_simps cf_adjunction_counit_NTMap_vsv cf_adjunction_unit_NTMap_vsv
)
qed
lemmas [cat_op_simps] = is_cf_adjunction.cf_adjunction_unit_NTMap_op
lemma (in is_cf_adjunction) cf_adjunction_counit_NTMap_op:
"Ξ΅β©C (op_cf_adj Ξ¦)β¦NTMapβ¦ = Ξ·β©C Ξ¦β¦NTMapβ¦"
by
(
rule is_cf_adjunction.cf_adjunction_unit_NTMap_op[
OF is_cf_adjunction_op,
unfolded is_cf_adjunction.cf_adjunction_op_cf_adj_op_cf_adj[
OF is_cf_adjunction_axioms
],
unfolded cat_op_simps,
symmetric
]
)
lemmas [cat_op_simps] = is_cf_adjunction.cf_adjunction_counit_NTMap_op
lemma (in is_cf_adjunction) op_ntcf_cf_adjunction_counit:
"op_ntcf (Ξ΅β©C Ξ¦) = Ξ·β©C (op_cf_adj Ξ¦)"
(is βΉ?Ξ΅ = ?Ξ·βΊ)
proof(rule vsv_eqI)
interpret op_Ξ¦:
is_cf_adjunction Ξ± βΉop_cat πβΊ βΉop_cat ββΊ βΉop_cf πβΊ βΉop_cf πβΊ βΉop_cf_adj Ξ¦βΊ
by (rule is_cf_adjunction_op)
have dom_lhs: "πβ©β ?Ξ΅ = 5β©β" unfolding op_ntcf_def by (simp add: nat_omega_simps)
have dom_rhs: "πβ©β ?Ξ· = 5β©β"
unfolding cf_adjunction_unit_def by (simp add: nat_omega_simps)
show "πβ©β ?Ξ΅ = πβ©β ?Ξ·" unfolding dom_lhs dom_rhs by simp
show "a ββ©β πβ©β ?Ξ΅ βΉ ?Ξ΅β¦aβ¦ = ?Ξ·β¦aβ¦" for a
by
(
unfold dom_lhs,
elim_in_numeral,
fold nt_field_simps,
unfold cf_adjunction_unit_NTMap_op,
unfold
cf_adjunction_counit_components'
cf_adjunction_unit_components'
op_Ξ¦.cf_adjunction_counit_components'
op_Ξ¦.cf_adjunction_unit_components'
cat_op_simps
)
simp_all
qed (auto simp: op_ntcf_def cf_adjunction_unit_def)
lemmas [cat_op_simps] = is_cf_adjunction.op_ntcf_cf_adjunction_counit
lemma (in is_cf_adjunction) op_ntcf_cf_adjunction_unit:
"op_ntcf (Ξ·β©C Ξ¦) = Ξ΅β©C (op_cf_adj Ξ¦)"
(is βΉ?Ξ· = ?Ξ΅βΊ)
proof(rule vsv_eqI)
interpret op_Ξ¦:
is_cf_adjunction Ξ± βΉop_cat πβΊ βΉop_cat ββΊ βΉop_cf πβΊ βΉop_cf πβΊ βΉop_cf_adj Ξ¦βΊ
by (rule is_cf_adjunction_op)
have dom_lhs: "πβ©β ?Ξ· = 5β©β"
unfolding op_ntcf_def by (simp add: nat_omega_simps)
have dom_rhs: "πβ©β ?Ξ΅ = 5β©β"
unfolding cf_adjunction_counit_def by (simp add: nat_omega_simps)
show "πβ©β ?Ξ· = πβ©β ?Ξ΅" unfolding dom_lhs dom_rhs by simp
show "a ββ©β πβ©β ?Ξ· βΉ ?Ξ·β¦aβ¦ = ?Ξ΅β¦aβ¦" for a
by
(
unfold dom_lhs,
elim_in_numeral,
fold nt_field_simps,
unfold cf_adjunction_counit_NTMap_op,
unfold
cf_adjunction_counit_components'
cf_adjunction_unit_components'
op_Ξ¦.cf_adjunction_counit_components'
op_Ξ¦.cf_adjunction_unit_components'
cat_op_simps
)
simp_all
qed (auto simp: op_ntcf_def cf_adjunction_counit_def)
lemmas [cat_op_simps] = is_cf_adjunction.op_ntcf_cf_adjunction_unit
subsubsectionβΉNatural transformation mapβΊ
lemma (in is_cf_adjunction) cf_adjunction_counit_NTMap_is_arr:
assumes "x ββ©β πβ¦Objβ¦"
shows "Ξ΅β©C Ξ¦β¦NTMapβ¦β¦xβ¦ : πβ¦ObjMapβ¦β¦πβ¦ObjMapβ¦β¦xβ¦β¦ β¦βπβ x"
proof-
from assms have x: "x ββ©β op_cat πβ¦Objβ¦" unfolding cat_op_simps by simp
show ?thesis
by
(
rule is_cf_adjunction.cf_adjunction_unit_NTMap_is_arr[
OF is_cf_adjunction_op x,
unfolded cf_adjunction_unit_NTMap_op cat_op_simps
]
)
qed
lemma (in is_cf_adjunction) cf_adjunction_counit_NTMap_is_arr':
assumes "x ββ©β πβ¦Objβ¦"
and "a = πβ¦ObjMapβ¦β¦πβ¦ObjMapβ¦β¦xβ¦β¦"
and "b = x"
and "π' = π"
shows "Ξ΅β©C Ξ¦β¦NTMapβ¦β¦xβ¦ : a β¦βπ'β b"
using assms(1) unfolding assms(2-4) by (rule cf_adjunction_counit_NTMap_is_arr)
lemmas [adj_cs_intros] = is_cf_adjunction.cf_adjunction_counit_NTMap_is_arr'
lemma (in is_cf_adjunction) cf_adjunction_counit_NTMap_vrange:
"ββ©β (Ξ΅β©C Ξ¦β¦NTMapβ¦) ββ©β πβ¦Arrβ¦"
by
(
rule is_cf_adjunction.cf_adjunction_unit_NTMap_vrange[
OF is_cf_adjunction_op,
unfolded cf_adjunction_unit_NTMap_op cat_op_simps
]
)
subsubsectionβΉCounit is a natural transformationβΊ
lemma (in is_cf_adjunction) cf_adjunction_counit_is_ntcf:
"Ξ΅β©C Ξ¦ : π ββ©Cβ©F π β¦β©Cβ©F cf_id π : π β¦β¦β©CβΞ±β π"
proof-
from is_cf_adjunction.cf_adjunction_unit_is_ntcf[OF is_cf_adjunction_op] have
"Ξ΅β©C Ξ¦ :
op_cf (op_cf π ββ©Cβ©F op_cf π) β¦β©Cβ©F op_cf (cf_id (op_cat π)) :
op_cat (op_cat π) β¦β¦β©CβΞ±β op_cat (op_cat π)"
unfolding
is_cf_adjunction.op_ntcf_cf_adjunction_unit[
OF is_cf_adjunction_op, unfolded cat_op_simps, symmetric
]
by (rule is_ntcf.is_ntcf_op)
then show ?thesis unfolding cat_op_simps .
qed
lemma (in is_cf_adjunction) cf_adjunction_counit_is_ntcf':
assumes "π = π ββ©Cβ©F π"
and "π' = cf_id π"
and "π = π"
and "π
= π"
shows "Ξ΅β©C Ξ¦ : π β¦β©Cβ©F π' : π β¦β¦β©CβΞ±β π
"
unfolding assms by (rule cf_adjunction_counit_is_ntcf)
lemmas [adj_cs_intros] = is_cf_adjunction.cf_adjunction_counit_is_ntcf'
subsubsectionβΉEvery component of a counit is a universal arrowβΊ
textβΉ
The lemmas in this subsection are based on elements of the statement of
Theorem 1 in Chapter IV-1 in \cite{mac_lane_categories_2010}.
βΊ
lemma (in is_cf_adjunction) cf_adj_umap_fo_counit:
assumes "x ββ©β πβ¦Objβ¦" and "a ββ©β ββ¦Objβ¦"
shows "op_cf_adj Ξ¦β¦AdjNTβ¦β¦NTMapβ¦β¦x, aβ¦β©β =
umap_fo π x (πβ¦ObjMapβ¦β¦xβ¦) (Ξ΅β©C Ξ¦β¦NTMapβ¦β¦xβ¦) a"
by
(
rule is_cf_adjunction.cf_adj_umap_of_unit[
OF is_cf_adjunction_op,
unfolded cat_op_simps,
OF assms,
unfolded cf_adjunction_unit_NTMap_op
]
)
lemma (in is_cf_adjunction) cf_adjunction_counit_component_is_ua_fo:
assumes "x ββ©β πβ¦Objβ¦"
shows "universal_arrow_fo π x (πβ¦ObjMapβ¦β¦xβ¦) (Ξ΅β©C Ξ¦β¦NTMapβ¦β¦xβ¦)"
by
(
rule is_cf_adjunction.cf_adjunction_unit_component_is_ua_of[
OF is_cf_adjunction_op,
unfolded cat_op_simps,
OF assms,
unfolded cf_adjunction_unit_NTMap_op
]
)
subsectionβΉCounit-unit equationsβΊ
textβΉ
The following equations appear as part of the statement of
Theorem 1 in Chapter IV-1 in \cite{mac_lane_categories_2010}.
These equations also appear in \cite{noauthor_wikipedia_2001},
where they are named βΉcounit-unit equationsβΊ.
βΊ
lemma (in is_cf_adjunction) cf_adjunction_counit_unit:
"(π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F Ξ΅β©C Ξ¦) ββ©Nβ©Tβ©Cβ©F (Ξ·β©C Ξ¦ ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π) = ntcf_id π"
(is βΉ(π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ?Ξ΅) ββ©Nβ©Tβ©Cβ©F (?Ξ· ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π) = ntcf_id πβΊ)
proof(rule ntcf_eqI)
from is_cf_adjunction_axioms show
"(π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ?Ξ΅) ββ©Nβ©Tβ©Cβ©F (?Ξ· ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π) : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β β"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros adj_cs_intros)
show "ntcf_id π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β β"
by (rule is_functor.cf_ntcf_id_is_ntcf[OF RL.is_functor_axioms])
from is_cf_adjunction_axioms have dom_lhs:
"πβ©β (((π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ?Ξ΅) ββ©Nβ©Tβ©Cβ©F (?Ξ· ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π))β¦NTMapβ¦) = πβ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros adj_cs_intros)
from is_cf_adjunction_axioms have dom_rhs: "πβ©β (ntcf_id πβ¦NTMapβ¦) = πβ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: adj_cs_intros)
show "((π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ?Ξ΅) ββ©Nβ©Tβ©Cβ©F (?Ξ· ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π))β¦NTMapβ¦ = ntcf_id πβ¦NTMapβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix a assume prems: "a ββ©β πβ¦Objβ¦"
let ?Ο_aa = βΉΞ¦β¦AdjNTβ¦β¦NTMapβ¦β¦πβ¦ObjMapβ¦β¦aβ¦, aβ¦β©ββΊ
have "category Ξ± (cat_Set Ξ±)"
by (rule category_cat_Set)
from is_cf_adjunction_axioms prems
L.category_axioms R.category_axioms
L.category_op R.category_op
LR.is_functor_axioms RL.is_functor_axioms
category_cat_Set
have
"?Ο_aaβ¦ArrValβ¦β¦?Ξ΅β¦NTMapβ¦β¦aβ¦β¦ =
(?Ο_aa ββ©Aβcat_Set Ξ±β ?Ο_aaΒ―β©Cβcat_Set Ξ±β)β¦ArrValβ¦β¦ββ¦CIdβ¦β¦πβ¦ObjMapβ¦β¦aβ¦β¦β¦"
by
(
cs_concl
cs_simp:
π΅.cat_Set_Comp_ArrVal
cat_Set_the_inverse[symmetric]
cat_cs_simps adj_cs_simps cat_prod_cs_simps
cs_intro:
cat_arrow_cs_intros
cat_cs_intros
cat_op_intros
adj_cs_intros
cat_prod_cs_intros
)
also from is_cf_adjunction_axioms prems
L.category_axioms R.category_axioms
L.category_op R.category_op
LR.is_functor_axioms RL.is_functor_axioms
category_cat_Set
have "β¦ = ββ¦CIdβ¦β¦πβ¦ObjMapβ¦β¦aβ¦β¦"
by (
cs_concl
cs_simp: cat_cs_simps category.cat_the_inverse_Comp_CId
cs_intro:
cat_arrow_cs_intros cat_cs_intros cat_op_intros cat_prod_cs_intros
)
finally have [cat_cs_simps]:
"(Ξ¦β¦AdjNTβ¦β¦NTMapβ¦β¦πβ¦ObjMapβ¦β¦aβ¦, aβ¦β©β)β¦ArrValβ¦β¦?Ξ΅β¦NTMapβ¦β¦aβ¦β¦ =
ββ¦CIdβ¦β¦πβ¦ObjMapβ¦β¦aβ¦β¦"
by simp
from
prems is_cf_adjunction_axioms
L.category_axioms R.category_axioms
show "((π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ?Ξ΅) ββ©Nβ©Tβ©Cβ©F (?Ξ· ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π))β¦NTMapβ¦β¦aβ¦ = ntcf_id πβ¦NTMapβ¦β¦aβ¦"
by
(
cs_concl
cs_simp:
cat_Set_the_inverse[symmetric]
cf_adj_Comp_commute_RL
cat_cs_simps
adj_cs_simps
cat_prod_cs_simps
cat_op_simps
cs_intro:
cat_arrow_cs_intros
cat_cs_intros
adj_cs_intros
cat_prod_cs_intros
cat_op_intros
)
qed (auto intro: cat_cs_intros)
qed simp_all
lemmas [adj_cs_simps] = is_cf_adjunction.cf_adjunction_counit_unit
lemma (in is_cf_adjunction) cf_adjunction_unit_counit:
"(Ξ΅β©C Ξ¦ ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π) ββ©Nβ©Tβ©Cβ©F (π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F Ξ·β©C Ξ¦) = ntcf_id π"
(is βΉ(?Ξ΅ ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π) ββ©Nβ©Tβ©Cβ©F (π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ?Ξ·) = ntcf_id πβΊ)
proof-
from is_cf_adjunction_axioms have πΞ·:
"π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ?Ξ· : π β¦β©Cβ©F π ββ©Cβ©F π ββ©Cβ©F π : β β¦β¦β©CβΞ±β π"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros adj_cs_intros)
from is_cf_adjunction_axioms have Ξ΅π:
"?Ξ΅ ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π : π ββ©Cβ©F π ββ©Cβ©F π β¦β©Cβ©F π : β β¦β¦β©CβΞ±β π"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros adj_cs_intros)
from πΞ· Ξ΅π have Ξ΅π_πΞ·:
"(?Ξ΅ ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π) ββ©Nβ©Tβ©Cβ©F (π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ?Ξ·) : π β¦β©Cβ©F π : β β¦β¦β©CβΞ±β π"
by (cs_concl cs_intro: cat_cs_intros)
from
is_cf_adjunction.cf_adjunction_counit_unit[
OF is_cf_adjunction_op,
unfolded
op_ntcf_cf_adjunction_unit[symmetric]
op_ntcf_cf_adjunction_counit[symmetric]
op_ntcf_cf_ntcf_comp[symmetric]
op_ntcf_ntcf_cf_comp[symmetric]
op_ntcf_ntcf_vcomp[symmetric]
op_ntcf_ntcf_vcomp[symmetric, OF Ξ΅π πΞ·]
LR.cf_ntcf_id_op_cf
]
have
"op_ntcf (op_ntcf ((?Ξ΅ ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π) ββ©Nβ©Tβ©Cβ©F (π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ?Ξ·))) =
op_ntcf (op_ntcf (ntcf_id π))"
by simp
from this is_cf_adjunction_axioms Ξ΅π_πΞ· show ?thesis
by (cs_prems cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_prod_cs_intros)
qed
lemmas [adj_cs_simps] = is_cf_adjunction.cf_adjunction_unit_counit
subsectionβΉ
Construction of an adjunction from universal morphisms
from objects to functors
βΊ
textβΉ
The subsection presents the construction of an adjunction given
a structured collection of universal morphisms from objects to functors.
The content of this subsection follows the statement and the proof
of Theorem 2-i in Chapter IV-1 in \cite{mac_lane_categories_2010}.
βΊ
subsubsectionβΉ
The natural transformation associated with the adjunction
constructed from universal morphisms from objects to functors
βΊ
definition cf_adjunction_AdjNT_of_unit :: "V β V β V β V β V"
where "cf_adjunction_AdjNT_of_unit Ξ± π π Ξ· =
[
(Ξ»cdββ©β(op_cat (πβ¦HomDomβ¦) Γβ©C πβ¦HomCodβ¦)β¦Objβ¦.
umap_of π (cdβ¦0β¦) (πβ¦ObjMapβ¦β¦cdβ¦0β¦β¦) (Ξ·β¦NTMapβ¦β¦cdβ¦0β¦β¦) (cdβ¦1β©ββ¦)),
Homβ©Oβ©.β©CβΞ±βπβ¦HomCodβ¦(π-,-),
Homβ©Oβ©.β©CβΞ±βπβ¦HomDomβ¦(-,π-),
op_cat (πβ¦HomDomβ¦) Γβ©C (πβ¦HomCodβ¦),
cat_Set Ξ±
]β©β"
textβΉComponents.βΊ
lemma cf_adjunction_AdjNT_of_unit_components:
shows "cf_adjunction_AdjNT_of_unit Ξ± π π Ξ·β¦NTMapβ¦ =
(
Ξ»cdββ©β(op_cat (πβ¦HomDomβ¦) Γβ©C πβ¦HomCodβ¦)β¦Objβ¦.
umap_of π (cdβ¦0β¦) (πβ¦ObjMapβ¦β¦cdβ¦0β¦β¦) (Ξ·β¦NTMapβ¦β¦cdβ¦0β¦β¦) (cdβ¦1β©ββ¦)
)"
and "cf_adjunction_AdjNT_of_unit Ξ± π π Ξ·β¦NTDomβ¦ = Homβ©Oβ©.β©CβΞ±βπβ¦HomCodβ¦(π-,-)"
and "cf_adjunction_AdjNT_of_unit Ξ± π π Ξ·β¦NTCodβ¦ = Homβ©Oβ©.β©CβΞ±βπβ¦HomDomβ¦(-,π-)"
and "cf_adjunction_AdjNT_of_unit Ξ± π π Ξ·β¦NTDGDomβ¦ =
op_cat (πβ¦HomDomβ¦) Γβ©C (πβ¦HomCodβ¦)"
and "cf_adjunction_AdjNT_of_unit Ξ± π π Ξ·β¦NTDGCodβ¦ = cat_Set Ξ±"
unfolding cf_adjunction_AdjNT_of_unit_def nt_field_simps
by (simp_all add: nat_omega_simps)
subsubsectionβΉNatural transformation mapβΊ
lemma cf_adjunction_AdjNT_of_unit_NTMap_vsv[adj_cs_intros]:
"vsv (cf_adjunction_AdjNT_of_unit Ξ± π π Ξ·β¦NTMapβ¦)"
unfolding cf_adjunction_AdjNT_of_unit_components by simp
lemma cf_adjunction_AdjNT_of_unit_NTMap_vdomain[adj_cs_simps]:
assumes "π : β β¦β¦β©CβΞ±β π"
shows "πβ©β (cf_adjunction_AdjNT_of_unit Ξ± π π Ξ·β¦NTMapβ¦) = (op_cat β Γβ©C π)β¦Objβ¦"
proof-
interpret is_functor Ξ± β π π by (rule assms(1))
show ?thesis
unfolding cf_adjunction_AdjNT_of_unit_components
by (simp add: cat_cs_simps)
qed
lemma cf_adjunction_AdjNT_of_unit_NTMap_app[adj_cs_simps]:
assumes "π : β β¦β¦β©CβΞ±β π" and "c ββ©β ββ¦Objβ¦" and "d ββ©β πβ¦Objβ¦"
shows
"cf_adjunction_AdjNT_of_unit Ξ± π π Ξ·β¦NTMapβ¦β¦c, dβ¦β©β =
umap_of π c (πβ¦ObjMapβ¦β¦cβ¦) (Ξ·β¦NTMapβ¦β¦cβ¦) d"
proof-
interpret π: is_functor Ξ± β π π by (rule assms(1))
from assms have "[c, d]β©β ββ©β (op_cat β Γβ©C π)β¦Objβ¦"
by (cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_prod_cs_intros)
then show "cf_adjunction_AdjNT_of_unit Ξ± π π Ξ·β¦NTMapβ¦ β¦c, dβ¦β©β =
umap_of π c (πβ¦ObjMapβ¦β¦cβ¦) (Ξ·β¦NTMapβ¦β¦cβ¦) d"
unfolding cf_adjunction_AdjNT_of_unit_components
by (simp add: nat_omega_simps cat_cs_simps)
qed
lemma cf_adjunction_AdjNT_of_unit_NTMap_vrange:
assumes "category Ξ± β"
and "category Ξ± π"
and "π : β β¦β¦β©CβΞ±β π"
and "π : π β¦β¦β©CβΞ±β β"
and "Ξ· : cf_id β β¦β©Cβ©F π ββ©Cβ©F π : β β¦β¦β©CβΞ±β β"
shows "ββ©β (cf_adjunction_AdjNT_of_unit Ξ± π π Ξ·β¦NTMapβ¦) ββ©β cat_Set Ξ±β¦Arrβ¦"
proof-
interpret π: is_functor Ξ± β π π by (rule assms(3))
show ?thesis
proof
(
rule vsv.vsv_vrange_vsubset,
unfold cf_adjunction_AdjNT_of_unit_NTMap_vdomain[OF assms(3)]
)
show "vsv (cf_adjunction_AdjNT_of_unit Ξ± π π Ξ·β¦NTMapβ¦)"
by (intro adj_cs_intros)
fix cd assume prems: "cd ββ©β (op_cat β Γβ©C π)β¦Objβ¦"
then obtain c d where cd_def: "cd = [c, d]β©β"
and c: "c ββ©β ββ¦Objβ¦"
and d: "d ββ©β πβ¦Objβ¦"
by
(
auto
simp: cat_op_simps
elim:
cat_prod_2_ObjE[OF π.HomDom.category_op π.HomCod.category_axioms]
)
from assms c d show
"cf_adjunction_AdjNT_of_unit Ξ± π π Ξ·β¦NTMapβ¦β¦cdβ¦ ββ©β cat_Set Ξ±β¦Arrβ¦"
unfolding cd_def
by (cs_concl cs_simp: cat_cs_simps adj_cs_simps cs_intro: cat_cs_intros)
qed
qed
subsubsectionβΉ
Adjunction constructed from universal morphisms
from objects to functors is an adjunction
βΊ
lemma cf_adjunction_AdjNT_of_unit_is_ntcf:
assumes "category Ξ± β"
and "category Ξ± π"
and "π : β β¦β¦β©CβΞ±β π"
and "π : π β¦β¦β©CβΞ±β β"
and "Ξ· : cf_id β β¦β©Cβ©F π ββ©Cβ©F π : β β¦β¦β©CβΞ±β β"
shows "cf_adjunction_AdjNT_of_unit Ξ± π π Ξ· :
Homβ©Oβ©.β©CβΞ±βπ(π-,-) β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±ββ(-,π-) :
op_cat β Γβ©C π β¦β¦β©CβΞ±β cat_Set Ξ±"
proof-
interpret β: category Ξ± β by (rule assms(1))
interpret π: category Ξ± π by (rule assms(2))
interpret π: is_functor Ξ± β π π by (rule assms(3))
interpret π: is_functor Ξ± π β π by (rule assms(4))
interpret Ξ·: is_ntcf Ξ± β β βΉcf_id ββΊ βΉπ ββ©Cβ©F πβΊ Ξ· by (rule assms(5))
show ?thesis
proof(intro is_ntcfI')
show "vfsequence (cf_adjunction_AdjNT_of_unit Ξ± π π Ξ·)"
unfolding cf_adjunction_AdjNT_of_unit_def by simp
show "vcard (cf_adjunction_AdjNT_of_unit Ξ± π π Ξ·) = 5β©β"
unfolding cf_adjunction_AdjNT_of_unit_def by (simp add: nat_omega_simps)
from assms(2,3) show
"Homβ©Oβ©.β©CβΞ±βπ(π-,-) : op_cat β Γβ©C π β¦β¦β©CβΞ±β cat_Set Ξ±"
by (cs_concl cs_intro: cat_cs_intros)
from assms show "Homβ©Oβ©.β©CβΞ±ββ(-,π-) : op_cat β Γβ©C π β¦β¦β©CβΞ±β cat_Set Ξ±"
by (cs_concl cs_intro: cat_cs_intros)
show "vsv (cf_adjunction_AdjNT_of_unit Ξ± π π Ξ·β¦NTMapβ¦)"
by (intro adj_cs_intros)
from assms show
"πβ©β (cf_adjunction_AdjNT_of_unit Ξ± π π Ξ·β¦NTMapβ¦) = (op_cat β Γβ©C π)β¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps adj_cs_simps)
show "cf_adjunction_AdjNT_of_unit Ξ± π π Ξ·β¦NTMapβ¦β¦cdβ¦ :
Homβ©Oβ©.β©CβΞ±βπ(π-,-)β¦ObjMapβ¦β¦cdβ¦ β¦βcat_Set Ξ±β
Homβ©Oβ©.β©CβΞ±ββ(-,π-)β¦ObjMapβ¦β¦cdβ¦"
if "cd ββ©β (op_cat β Γβ©C π)β¦Objβ¦" for cd
proof-
from that obtain c d
where cd_def: "cd = [c, d]β©β" and c: "c ββ©β ββ¦Objβ¦" and d: "d ββ©β πβ¦Objβ¦"
by
(
auto
simp: cat_op_simps
elim: cat_prod_2_ObjE[OF β.category_op π.category_axioms]
)
from assms c d show ?thesis
unfolding cd_def
by
(
cs_concl
cs_simp: adj_cs_simps cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
qed
show
"cf_adjunction_AdjNT_of_unit Ξ± π π Ξ·β¦NTMapβ¦β¦c'd'β¦ ββ©Aβcat_Set Ξ±β
Homβ©Oβ©.β©CβΞ±βπ(π-,-)β¦ArrMapβ¦β¦gfβ¦ =
Homβ©Oβ©.β©CβΞ±ββ(-,π-)β¦ArrMapβ¦β¦gfβ¦ ββ©Aβcat_Set Ξ±β
cf_adjunction_AdjNT_of_unit Ξ± π π Ξ·β¦NTMapβ¦β¦cdβ¦"
if "gf : cd β¦βop_cat β Γβ©C πβ c'd'" for cd c'd' gf
proof-
from that obtain g f c c' d d'
where gf_def: "gf = [g, f]β©β"
and cd_def: "cd = [c, d]β©β"
and c'd'_def: "c'd' = [c', d']β©β"
and g: "g : c' β¦βββ c"
and f: "f : d β¦βπβ d'"
by
(
auto
simp: cat_op_simps
elim: cat_prod_2_is_arrE[OF β.category_op π.category_axioms]
)
from assms g f that show ?thesis
unfolding gf_def cd_def c'd'_def
by
(
cs_concl
cs_simp: cf_umap_of_cf_hom_unit_commute adj_cs_simps cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
qed
qed (auto simp: cf_adjunction_AdjNT_of_unit_components cat_cs_simps)
qed
lemma cf_adjunction_AdjNT_of_unit_is_ntcf'[adj_cs_intros]:
assumes "category Ξ± β"
and "category Ξ± π"
and "π : β β¦β¦β©CβΞ±β π"
and "π : π β¦β¦β©CβΞ±β β"
and "Ξ· : cf_id β β¦β©Cβ©F π ββ©Cβ©F π : β β¦β¦β©CβΞ±β β"
and "π = Homβ©Oβ©.β©CβΞ±βπ(π-,-)"
and "π' = Homβ©Oβ©.β©CβΞ±ββ(-,π-)"
and "π = op_cat β Γβ©C π"
and "π
= cat_Set Ξ±"
shows "cf_adjunction_AdjNT_of_unit Ξ± π π Ξ· : π β¦β©Cβ©F π' : π β¦β¦β©CβΞ±β π
"
using assms(1-5) unfolding assms(6-9)
by (rule cf_adjunction_AdjNT_of_unit_is_ntcf)
subsubsectionβΉ
Adjunction constructed from universal morphisms from objects to functors
βΊ
definition cf_adjunction_of_unit :: "V β V β V β V β V"
where "cf_adjunction_of_unit Ξ± π π Ξ· =
[π, π, cf_adjunction_AdjNT_of_unit Ξ± π π Ξ·]β©β"
textβΉComponents.βΊ
lemma cf_adjunction_of_unit_components:
shows [adj_cs_simps]: "cf_adjunction_of_unit Ξ± π π Ξ·β¦AdjLeftβ¦ = π"
and [adj_cs_simps]: "cf_adjunction_of_unit Ξ± π π Ξ·β¦AdjRightβ¦ = π"
and "cf_adjunction_of_unit Ξ± π π Ξ·β¦AdjNTβ¦ =
cf_adjunction_AdjNT_of_unit Ξ± π π Ξ·"
unfolding cf_adjunction_of_unit_def adj_field_simps
by (simp_all add: nat_omega_simps)
textβΉNatural transformation map.βΊ
lemma cf_adjunction_of_unit_AdjNT_NTMap_vdomain[adj_cs_simps]:
assumes "π : β β¦β¦β©CβΞ±β π"
shows "πβ©β (cf_adjunction_of_unit Ξ± π π Ξ·β¦AdjNTβ¦β¦NTMapβ¦) =
(op_cat β Γβ©C π)β¦Objβ¦"
using assms
unfolding cf_adjunction_of_unit_components(3)
by (rule cf_adjunction_AdjNT_of_unit_NTMap_vdomain)
lemma cf_adjunction_of_unit_AdjNT_NTMap_app[adj_cs_simps]:
assumes "π : β β¦β¦β©CβΞ±β π" and "c ββ©β ββ¦Objβ¦" and "d ββ©β πβ¦Objβ¦"
shows
"cf_adjunction_of_unit Ξ± π π Ξ·β¦AdjNTβ¦β¦NTMapβ¦β¦c, dβ¦β©β =
umap_of π c (πβ¦ObjMapβ¦β¦cβ¦) (Ξ·β¦NTMapβ¦β¦cβ¦) d"
using assms
unfolding cf_adjunction_of_unit_components(3)
by (rule cf_adjunction_AdjNT_of_unit_NTMap_app)
textβΉ
The adjunction constructed from universal morphisms from objects to
functors is an adjunction.
βΊ
lemma cf_adjunction_of_unit_is_cf_adjunction:
assumes "category Ξ± β"
and "category Ξ± π"
and "π : β β¦β¦β©CβΞ±β π"
and "π : π β¦β¦β©CβΞ±β β"
and "Ξ· : cf_id β β¦β©Cβ©F π ββ©Cβ©F π : β β¦β¦β©CβΞ±β β"
and "βx. x ββ©β ββ¦Objβ¦ βΉ universal_arrow_of π x (πβ¦ObjMapβ¦β¦xβ¦) (Ξ·β¦NTMapβ¦β¦xβ¦)"
shows "cf_adjunction_of_unit Ξ± π π Ξ· : π ββ©Cβ©F π : β βββ©CβΞ±β π"
and "Ξ·β©C (cf_adjunction_of_unit Ξ± π π Ξ·) = Ξ·"
proof-
interpret β: category Ξ± β by (rule assms(1))
interpret π: category Ξ± π by (rule assms(2))
interpret π: is_functor Ξ± β π π by (rule assms(3))
interpret π: is_functor Ξ± π β π by (rule assms(4))
interpret Ξ·: is_ntcf Ξ± β β βΉcf_id ββΊ βΉπ ββ©Cβ©F πβΊ Ξ· by (rule assms(5))
show caou_Ξ·: "cf_adjunction_of_unit Ξ± π π Ξ· : π ββ©Cβ©F π : β βββ©CβΞ±β π"
proof
(
intro
is_cf_adjunctionI[OF _ _ assms(1-4)]
is_iso_ntcf_if_bnt_proj_snd_is_iso_ntcf[
OF β.category_op π.category_axioms
],
unfold cat_op_simps cf_adjunction_of_unit_components
)
show caou_Ξ·: "cf_adjunction_AdjNT_of_unit Ξ± π π Ξ· :
Homβ©Oβ©.β©CβΞ±βπ(π-,-) β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±ββ(-,π-) :
op_cat β Γβ©C π β¦β¦β©CβΞ±β cat_Set Ξ±"
unfolding cf_adjunction_of_unit_components
by (rule cf_adjunction_AdjNT_of_unit_is_ntcf[OF assms(1-5)])
fix a assume prems: "a ββ©β ββ¦Objβ¦"
have ua_of_Ξ·a:
"ntcf_ua_of Ξ± π a (πβ¦ObjMapβ¦β¦aβ¦) (Ξ·β¦NTMapβ¦β¦aβ¦) :
Homβ©Oβ©.β©CβΞ±βπ(πβ¦ObjMapβ¦β¦aβ¦,-) β¦β©Cβ©Fβ©.β©iβ©sβ©o Homβ©Oβ©.β©CβΞ±ββ(a,-) ββ©Cβ©F π :
π β¦β¦β©CβΞ±β cat_Set Ξ±"
by
(
rule is_functor.cf_ntcf_ua_of_is_iso_ntcf[
OF assms(4) assms(6)[OF prems]
]
)
have [adj_cs_simps]:
"cf_adjunction_AdjNT_of_unit Ξ± π π Ξ·βop_cat β,πβ(a,-)β©Nβ©Tβ©Cβ©F =
ntcf_ua_of Ξ± π a (πβ¦ObjMapβ¦β¦aβ¦) (Ξ·β¦NTMapβ¦β¦aβ¦)"
proof(rule ntcf_eqI)
from assms(1-5) caou_Ξ· prems show lhs:
"cf_adjunction_AdjNT_of_unit Ξ± π π Ξ·βop_cat β,πβ(a,-)β©Nβ©Tβ©Cβ©F :
Homβ©Oβ©.β©CβΞ±βπ(πβ¦ObjMapβ¦β¦aβ¦,-) β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±ββ(a,-) ββ©Cβ©F π :
π β¦β¦β©CβΞ±β cat_Set Ξ±"
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros
)
from ua_of_Ξ·a show rhs:
"ntcf_ua_of Ξ± π a (πβ¦ObjMapβ¦β¦aβ¦) (Ξ·β¦NTMapβ¦β¦aβ¦) :
Homβ©Oβ©.β©CβΞ±βπ(πβ¦ObjMapβ¦β¦aβ¦,-) β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±ββ(a,-) ββ©Cβ©F π :
π β¦β¦β©CβΞ±β cat_Set Ξ±"
by (cs_concl cs_intro: ntcf_cs_intros)
from lhs have dom_lhs:
"πβ©β ((cf_adjunction_AdjNT_of_unit Ξ± π π Ξ·βop_cat β,πβ(a,-)β©Nβ©Tβ©Cβ©F)β¦NTMapβ¦) =
πβ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps)
from lhs assms(4) have dom_rhs:
"πβ©β (ntcf_ua_of Ξ± π a (πβ¦ObjMapβ¦β¦aβ¦) (Ξ·β¦NTMapβ¦β¦aβ¦)β¦NTMapβ¦) = πβ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps)
show
"(cf_adjunction_AdjNT_of_unit Ξ± π π Ξ·βop_cat β,πβ(a,-)β©Nβ©Tβ©Cβ©F)β¦NTMapβ¦ =
ntcf_ua_of Ξ± π a (πβ¦ObjMapβ¦β¦aβ¦) (Ξ·β¦NTMapβ¦β¦aβ¦)β¦NTMapβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix d assume prems': "d ββ©β πβ¦Objβ¦"
from assms(3,4) prems prems' show
"(cf_adjunction_AdjNT_of_unit Ξ± π π Ξ·βop_cat β,πβ(a,-)β©Nβ©Tβ©Cβ©F)β¦NTMapβ¦β¦dβ¦ =
ntcf_ua_of Ξ± π a (πβ¦ObjMapβ¦β¦aβ¦) (Ξ·β¦NTMapβ¦β¦aβ¦)β¦NTMapβ¦β¦dβ¦"
by (cs_concl cs_simp: adj_cs_simps cat_cs_simps)
qed (simp_all add: bnt_proj_snd_NTMap_vsv π.ntcf_ua_of_NTMap_vsv)
qed simp_all
from assms(1-5) assms(6)[OF prems] prems show
"cf_adjunction_AdjNT_of_unit Ξ± π π Ξ·βop_cat β,πβ(a,-)β©Nβ©Tβ©Cβ©F :
Homβ©Oβ©.β©CβΞ±βπ(π-,-)βop_cat β,πβ(a,-)β©Cβ©F β¦β©Cβ©Fβ©.β©iβ©sβ©o
Homβ©Oβ©.β©CβΞ±ββ(-,π-)βop_cat β,πβ(a,-)β©Cβ©F :
π β¦β¦β©CβΞ±β cat_Set Ξ±"
by (cs_concl cs_simp: adj_cs_simps cat_cs_simps cs_intro: cat_cs_intros)
qed (auto simp: cf_adjunction_of_unit_def nat_omega_simps)
show "Ξ·β©C (cf_adjunction_of_unit Ξ± π π Ξ·) = Ξ·"
proof(rule ntcf_eqI)
from caou_Ξ· show lhs:
"Ξ·β©C (cf_adjunction_of_unit Ξ± π π Ξ·) :
cf_id β β¦β©Cβ©F π ββ©Cβ©F π : β β¦β¦β©CβΞ±β β"
by (cs_concl cs_intro: adj_cs_intros)
show rhs: "Ξ· : cf_id β β¦β©Cβ©F π ββ©Cβ©F π : β β¦β¦β©CβΞ±β β"
by (auto intro: cat_cs_intros)
from lhs have dom_lhs:
"πβ©β (Ξ·β©C (cf_adjunction_of_unit Ξ± π π Ξ·)β¦NTMapβ¦) = ββ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps)
have dom_rhs: "πβ©β (Ξ·β¦NTMapβ¦) = ββ¦Objβ¦" by (auto simp: cat_cs_simps)
show "Ξ·β©C (cf_adjunction_of_unit Ξ± π π Ξ·)β¦NTMapβ¦ = Ξ·β¦NTMapβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix a assume prems: "a ββ©β ββ¦Objβ¦"
from assms(1-5) prems caou_Ξ· show
"Ξ·β©C (cf_adjunction_of_unit Ξ± π π Ξ·)β¦NTMapβ¦β¦aβ¦ = Ξ·β¦NTMapβ¦β¦aβ¦"
by
(
cs_concl
cs_simp:
adj_cs_simps cat_cs_simps cf_adjunction_of_unit_components(3)
cs_intro: cat_cs_intros
)
qed (auto intro: adj_cs_intros)
qed simp_all
qed
subsectionβΉ
Construction of an adjunction from a functor and universal morphisms
from objects to functors
βΊ
textβΉ
The subsection presents the construction of an adjunction given
a functor and a structured collection of universal morphisms
from objects to functors.
The content of this subsection follows the statement and the proof
of Theorem 2-ii in Chapter IV-1 in \cite{mac_lane_categories_2010}.
βΊ
subsubsectionβΉLeft adjointβΊ
definition cf_la_of_ra :: "(V β V) β V β V β V"
where "cf_la_of_ra F π Ξ· =
[
(Ξ»xββ©βπβ¦HomCodβ¦β¦Objβ¦. F x),
(
Ξ»hββ©βπβ¦HomCodβ¦β¦Arrβ¦. THE f'.
f' : F (πβ¦HomCodβ¦β¦Domβ¦β¦hβ¦) β¦βπβ¦HomDomβ¦β F (πβ¦HomCodβ¦β¦Codβ¦β¦hβ¦) β§
Ξ·β¦NTMapβ¦β¦πβ¦HomCodβ¦β¦Codβ¦β¦hβ¦β¦ ββ©Aβπβ¦HomCodβ¦β h =
(
umap_of
π
(πβ¦HomCodβ¦β¦Domβ¦β¦hβ¦)
(F (πβ¦HomCodβ¦β¦Domβ¦β¦hβ¦))
(Ξ·β¦NTMapβ¦β¦πβ¦HomCodβ¦β¦Domβ¦β¦hβ¦β¦)
(F (πβ¦HomCodβ¦β¦Codβ¦β¦hβ¦))
)β¦ArrValβ¦β¦f'β¦
),
πβ¦HomCodβ¦,
πβ¦HomDomβ¦
]β©β"
textβΉComponents.βΊ
lemma cf_la_of_ra_components:
shows "cf_la_of_ra F π Ξ·β¦ObjMapβ¦ = (Ξ»xββ©βπβ¦HomCodβ¦β¦Objβ¦. F x)"
and "cf_la_of_ra F π Ξ·β¦ArrMapβ¦ =
(
Ξ»hββ©βπβ¦HomCodβ¦β¦Arrβ¦. THE f'.
f' : F (πβ¦HomCodβ¦β¦Domβ¦β¦hβ¦) β¦βπβ¦HomDomβ¦β F (πβ¦HomCodβ¦β¦Codβ¦β¦hβ¦) β§
Ξ·β¦NTMapβ¦β¦πβ¦HomCodβ¦β¦Codβ¦β¦hβ¦β¦ ββ©Aβπβ¦HomCodβ¦β h =
(
umap_of
π
(πβ¦HomCodβ¦β¦Domβ¦β¦hβ¦)
(F (πβ¦HomCodβ¦β¦Domβ¦β¦hβ¦))
(Ξ·β¦NTMapβ¦β¦πβ¦HomCodβ¦β¦Domβ¦β¦hβ¦β¦)
(F (πβ¦HomCodβ¦β¦Codβ¦β¦hβ¦))
)β¦ArrValβ¦β¦f'β¦
)"
and "cf_la_of_ra F π Ξ·β¦HomDomβ¦ = πβ¦HomCodβ¦"
and "cf_la_of_ra F π Ξ·β¦HomCodβ¦ = πβ¦HomDomβ¦"
unfolding cf_la_of_ra_def dghm_field_simps by (simp_all add: nat_omega_simps)
subsubsectionβΉObject mapβΊ
mk_VLambda cf_la_of_ra_components(1)
|vsv cf_la_of_ra_ObjMap_vsv[adj_cs_intros]|
mk_VLambda (in is_functor)
cf_la_of_ra_components(1)[where ?π=π, unfolded cf_HomCod]
|vdomain cf_la_of_ra_ObjMap_vdomain[adj_cs_simps]|
|app cf_la_of_ra_ObjMap_app[adj_cs_simps]|
lemmas [adj_cs_simps] =
is_functor.cf_la_of_ra_ObjMap_vdomain
is_functor.cf_la_of_ra_ObjMap_app
subsubsectionβΉArrow mapβΊ
mk_VLambda cf_la_of_ra_components(2)
|vsv cf_la_of_ra_ArrMap_vsv[adj_cs_intros]|
mk_VLambda (in is_functor)
cf_la_of_ra_components(2)[where ?π=π, unfolded cf_HomCod cf_HomDom]
|vdomain cf_la_of_ra_ArrMap_vdomain[adj_cs_simps]|
|app cf_la_of_ra_ArrMap_app|
lemmas [adj_cs_simps] = is_functor.cf_la_of_ra_ArrMap_vdomain
lemma (in is_functor) cf_la_of_ra_ArrMap_app':
assumes "h : a β¦βπ
β b"
shows
"cf_la_of_ra F π Ξ·β¦ArrMapβ¦β¦hβ¦ =
(
THE f'.
f' : F a β¦βπβ F b β§
Ξ·β¦NTMapβ¦β¦bβ¦ ββ©Aβπ
β h = umap_of π a (F a) (Ξ·β¦NTMapβ¦β¦aβ¦) (F b)β¦ArrValβ¦β¦f'β¦
)"
proof-
from assms have h: "h ββ©β π
β¦Arrβ¦" by (simp add: cat_cs_intros)
from assms have h_Dom: "π
β¦Domβ¦β¦hβ¦ = a" and h_Cod: "π
β¦Codβ¦β¦hβ¦ = b"
by (simp_all add: cat_cs_simps)
show ?thesis by (rule cf_la_of_ra_ArrMap_app[OF h, unfolded h_Dom h_Cod])
qed
lemma cf_la_of_ra_ArrMap_app_unique:
assumes "π : π β¦β¦β©CβΞ±β β"
and "f : a β¦βββ b"
and "universal_arrow_of π a (cf_la_of_ra F π Ξ·β¦ObjMapβ¦β¦aβ¦) (Ξ·β¦NTMapβ¦β¦aβ¦)"
and "universal_arrow_of π b (cf_la_of_ra F π Ξ·β¦ObjMapβ¦β¦bβ¦) (Ξ·β¦NTMapβ¦β¦bβ¦)"
shows "cf_la_of_ra F π Ξ·β¦ArrMapβ¦β¦fβ¦ : F a β¦βπβ F b"
and "Ξ·β¦NTMapβ¦β¦bβ¦ ββ©Aβββ f = umap_of
π a (F a) (Ξ·β¦NTMapβ¦β¦aβ¦) (F b)β¦ArrValβ¦β¦cf_la_of_ra F π Ξ·β¦ArrMapβ¦β¦fβ¦β¦"
and "βf'.
β¦
f' : F a β¦βπβ F b;
Ξ·β¦NTMapβ¦β¦bβ¦ ββ©Aβββ f = umap_of π a (F a) (Ξ·β¦NTMapβ¦β¦aβ¦) (F b)β¦ArrValβ¦β¦f'β¦
β§ βΉ cf_la_of_ra F π Ξ·β¦ArrMapβ¦β¦fβ¦ = f'"
proof-
interpret π: is_functor Ξ± π β π by (rule assms(1))
from assms(2) have a: "a ββ©β ββ¦Objβ¦" and b: "b ββ©β ββ¦Objβ¦"
by (simp_all add: cat_cs_intros)
note ua_Ξ·_a = π.universal_arrow_ofD[OF assms(3)]
note ua_Ξ·_b = π.universal_arrow_ofD[OF assms(4)]
from ua_Ξ·_b(2) have [cat_cs_intros]:
"β¦ c = b; c' = πβ¦ObjMapβ¦β¦cf_la_of_ra F π Ξ·β¦ObjMapβ¦β¦bβ¦β¦ β§ βΉ
Ξ·β¦NTMapβ¦β¦bβ¦ : c β¦βββ c'"
for c c'
by auto
from assms(1,2) ua_Ξ·_a(2) have Ξ·a_f:
"Ξ·β¦NTMapβ¦β¦bβ¦ ββ©Aβββ f : a β¦βββ πβ¦ObjMapβ¦β¦cf_la_of_ra F π Ξ·β¦ObjMapβ¦β¦bβ¦β¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms(1,2) have lara_a: "cf_la_of_ra F π Ξ·β¦ObjMapβ¦β¦aβ¦ = F a"
and lara_b: "cf_la_of_ra F π Ξ·β¦ObjMapβ¦β¦bβ¦ = F b"
by (cs_concl cs_simp: adj_cs_simps cs_intro: cat_cs_intros)+
from theD
[
OF
ua_Ξ·_a(3)[OF ua_Ξ·_b(1) Ξ·a_f, unfolded lara_a lara_b]
π.cf_la_of_ra_ArrMap_app'[OF assms(2), of F Ξ·]
]
show "cf_la_of_ra F π Ξ·β¦ArrMapβ¦β¦fβ¦ : F a β¦βπβ F b"
and "Ξ·β¦NTMapβ¦β¦bβ¦ ββ©Aβββ f = umap_of
π a (F a) (Ξ·β¦NTMapβ¦β¦aβ¦) (F b)β¦ArrValβ¦β¦cf_la_of_ra F π Ξ·β¦ArrMapβ¦β¦fβ¦β¦"
and "βf'.
β¦
f' : F a β¦βπβ F b;
Ξ·β¦NTMapβ¦β¦bβ¦ ββ©Aβββ f = umap_of π a (F a) (Ξ·β¦NTMapβ¦β¦aβ¦) (F b)β¦ArrValβ¦β¦f'β¦
β§ βΉ cf_la_of_ra F π Ξ·β¦ArrMapβ¦β¦fβ¦ = f'"
by blast+
qed
lemma cf_la_of_ra_ArrMap_app_is_arr[adj_cs_intros]:
assumes "π : π β¦β¦β©CβΞ±β β"
and "f : a β¦βββ b"
and "universal_arrow_of π a (cf_la_of_ra F π Ξ·β¦ObjMapβ¦β¦aβ¦) (Ξ·β¦NTMapβ¦β¦aβ¦)"
and "universal_arrow_of π b (cf_la_of_ra F π Ξ·β¦ObjMapβ¦β¦bβ¦) (Ξ·β¦NTMapβ¦β¦bβ¦)"
and "Fa = F a"
and "Fb = F b"
shows "cf_la_of_ra F π Ξ·β¦ArrMapβ¦β¦fβ¦ : Fa β¦βπβ Fb"
using assms(1-4) unfolding assms(5,6) by (rule cf_la_of_ra_ArrMap_app_unique)
subsubsectionβΉ
An adjunction constructed from a functor and universal morphisms
from objects to functors is an adjunction
βΊ
lemma cf_la_of_ra_is_functor:
assumes "π : π β¦β¦β©CβΞ±β β"
and "βc. c ββ©β ββ¦Objβ¦ βΉ F c ββ©β πβ¦Objβ¦"
and "βc. c ββ©β ββ¦Objβ¦ βΉ
universal_arrow_of π c (cf_la_of_ra F π Ξ·β¦ObjMapβ¦β¦cβ¦) (Ξ·β¦NTMapβ¦β¦cβ¦)"
and "βc c' h. h : c β¦βββ c' βΉ
πβ¦ArrMapβ¦β¦cf_la_of_ra F π Ξ·β¦ArrMapβ¦β¦hβ¦β¦ ββ©Aβββ (Ξ·β¦NTMapβ¦β¦cβ¦) =
(Ξ·β¦NTMapβ¦β¦c'β¦) ββ©Aβββ h"
shows "cf_la_of_ra F π Ξ· : β β¦β¦β©CβΞ±β π" (is βΉ?π : β β¦β¦β©CβΞ±β πβΊ)
proof-
interpret π: is_functor Ξ± π β π by (rule assms(1))
show "cf_la_of_ra F π Ξ· : β β¦β¦β©CβΞ±β π"
proof(rule is_functorI')
show "vfsequence ?π" unfolding cf_la_of_ra_def by auto
show "vcard ?π = 4β©β"
unfolding cf_la_of_ra_def by (simp add: nat_omega_simps)
show "ββ©β (?πβ¦ObjMapβ¦) ββ©β πβ¦Objβ¦"
proof(rule vsv.vsv_vrange_vsubset, unfold π.cf_la_of_ra_ObjMap_vdomain)
fix x assume "x ββ©β ββ¦Objβ¦"
with assms(1) show "?πβ¦ObjMapβ¦β¦xβ¦ ββ©β πβ¦Objβ¦"
by (cs_concl cs_simp: adj_cs_simps cs_intro: assms(2))
qed (auto intro: adj_cs_intros)
show "?πβ¦ArrMapβ¦β¦fβ¦ : ?πβ¦ObjMapβ¦β¦aβ¦ β¦βπβ ?πβ¦ObjMapβ¦β¦bβ¦"
if "f : a β¦βββ b" for a b f
proof-
from that have a: "a ββ©β ββ¦Objβ¦" and b: "b ββ©β ββ¦Objβ¦"
by (simp_all add: cat_cs_intros)
have ua_Ξ·_a: "universal_arrow_of π a (?πβ¦ObjMapβ¦β¦aβ¦) (Ξ·β¦NTMapβ¦β¦aβ¦)"
and ua_Ξ·_b: "universal_arrow_of π b (?πβ¦ObjMapβ¦β¦bβ¦) (Ξ·β¦NTMapβ¦β¦bβ¦)"
by (intro assms(3)[OF a] assms(3)[OF b])+
from a b cf_la_of_ra_ArrMap_app_unique(1)[OF assms(1) that ua_Ξ·_a ua_Ξ·_b]
show ?thesis
by (cs_concl cs_simp: adj_cs_simps)
qed
show "?πβ¦ArrMapβ¦β¦g ββ©Aβββ fβ¦ = ?πβ¦ArrMapβ¦β¦gβ¦ ββ©Aβπβ ?πβ¦ArrMapβ¦β¦fβ¦"
if "g : b β¦βββ c" and "f : a β¦βββ b" for b c g a f
proof-
from that have a: "a ββ©β ββ¦Objβ¦" and b: "b ββ©β ββ¦Objβ¦" and c: "c ββ©β ββ¦Objβ¦"
by (simp_all add: cat_cs_intros)
from assms(1) that have gf: "g ββ©Aβββ f : a β¦βββ c"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
note ua_Ξ·_a = assms(3)[OF a]
and ua_Ξ·_b = assms(3)[OF b]
and ua_Ξ·_c = assms(3)[OF c]
note lara_f =
cf_la_of_ra_ArrMap_app_unique[OF assms(1) that(2) ua_Ξ·_a ua_Ξ·_b]
note lara_g =
cf_la_of_ra_ArrMap_app_unique[OF assms(1) that(1) ua_Ξ·_b ua_Ξ·_c]
note lara_gf =
cf_la_of_ra_ArrMap_app_unique[OF assms(1) gf ua_Ξ·_a ua_Ξ·_c]
note ua_Ξ·_a = π.universal_arrow_ofD[OF ua_Ξ·_a]
and ua_Ξ·_b = π.universal_arrow_ofD[OF ua_Ξ·_b]
and ua_Ξ·_c = π.universal_arrow_ofD[OF ua_Ξ·_c]
from ua_Ξ·_a(2) assms(1) that have Ξ·a:
"Ξ·β¦NTMapβ¦β¦aβ¦ : a β¦βββ πβ¦ObjMapβ¦β¦F aβ¦"
by (cs_prems cs_simp: adj_cs_simps cs_intro: cat_cs_intros)
from ua_Ξ·_b(2) assms(1) that have Ξ·b:
"Ξ·β¦NTMapβ¦β¦bβ¦ : b β¦βββ πβ¦ObjMapβ¦β¦F bβ¦"
by (cs_prems cs_simp: adj_cs_simps cs_intro: cat_cs_intros)
from ua_Ξ·_c(2) assms(1) that have Ξ·c:
"Ξ·β¦NTMapβ¦β¦cβ¦ : c β¦βββ πβ¦ObjMapβ¦β¦F cβ¦"
by (cs_prems cs_simp: adj_cs_simps cs_intro: cat_cs_intros)
from assms(1) that Ξ·c have
"Ξ·β¦NTMapβ¦β¦cβ¦ ββ©Aβββ (g ββ©Aβββ f) = (Ξ·β¦NTMapβ¦β¦cβ¦ ββ©Aβββ g) ββ©Aβββ f"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
also from assms(1) lara_g(1) that(2) Ξ·b have "β¦ =
πβ¦ArrMapβ¦β¦?πβ¦ArrMapβ¦β¦gβ¦β¦ ββ©Aβββ (Ξ·β¦NTMapβ¦β¦bβ¦ ββ©Aβββ f)"
by
(
cs_concl
cs_simp: lara_g(2) cat_cs_simps
cs_intro: cat_cs_intros cat_prod_cs_intros
)
also from assms(1) lara_f(1) Ξ·a have "β¦ =
πβ¦ArrMapβ¦β¦?πβ¦ArrMapβ¦β¦gβ¦β¦ ββ©Aβββ
(πβ¦ArrMapβ¦β¦?πβ¦ArrMapβ¦β¦fβ¦β¦ ββ©Aβββ Ξ·β¦NTMapβ¦β¦aβ¦)"
by (cs_concl cs_simp: lara_f(2) cat_cs_simps)
finally have [symmetric, cat_cs_simps]:
"Ξ·β¦NTMapβ¦β¦cβ¦ ββ©Aβββ (g ββ©Aβββ f) = β¦".
from assms(1) this Ξ·a Ξ·b Ξ·c lara_g(1) lara_f(1) have
"Ξ·β¦NTMapβ¦β¦cβ¦ ββ©Aβββ (g ββ©Aβββ f) =
umap_of π a (F a) (Ξ·β¦NTMapβ¦β¦aβ¦) (F c)β¦ArrValβ¦β¦?πβ¦ArrMapβ¦β¦gβ¦ ββ©Aβπβ
?πβ¦ArrMapβ¦β¦fβ¦β¦"
by
(
cs_concl
cs_simp: adj_cs_simps cat_cs_simps
cs_intro: adj_cs_intros cat_cs_intros
)
moreover from assms(1) lara_g(1) lara_f(1) have
"?πβ¦ArrMapβ¦β¦gβ¦ ββ©Aβπβ ?πβ¦ArrMapβ¦β¦fβ¦ : F a β¦βπβ F c"
by (cs_concl cs_intro: adj_cs_intros cat_cs_intros)
ultimately show ?thesis by (intro lara_gf(3))
qed
show "?πβ¦ArrMapβ¦β¦ββ¦CIdβ¦β¦cβ¦β¦ = πβ¦CIdβ¦β¦?πβ¦ObjMapβ¦β¦cβ¦β¦" if "c ββ©β ββ¦Objβ¦" for c
proof-
note lara_c = cf_la_of_ra_ArrMap_app_unique[
OF
assms(1)
π.HomCod.cat_CId_is_arr[OF that]
assms(3)[OF that]
assms(3)[OF that]
]
from assms(1) that have πc: "πβ¦CIdβ¦β¦F cβ¦ : F c β¦βπβ F c "
by (cs_concl cs_simp: cat_cs_simps cs_intro: assms(2) cat_cs_intros)
from π.universal_arrow_ofD(2)[OF assms(3)[OF that]] assms(1) that have Ξ·c:
"Ξ·β¦NTMapβ¦β¦cβ¦ : c β¦βββ πβ¦ObjMapβ¦β¦F cβ¦"
by (cs_prems cs_simp: adj_cs_simps cs_intro: cat_cs_intros)
from assms(1) that Ξ·c have
"Ξ·β¦NTMapβ¦β¦cβ¦ ββ©Aβββ ββ¦CIdβ¦β¦cβ¦ =
umap_of π c (F c) (Ξ·β¦NTMapβ¦β¦cβ¦) (F c)β¦ArrValβ¦β¦πβ¦CIdβ¦β¦F cβ¦β¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: assms(2) cat_cs_intros)
note [cat_cs_simps] = lara_c(3)[OF πc this]
from assms(1) that πc show ?thesis
by (cs_concl cs_simp: adj_cs_simps cat_cs_simps cs_intro: cat_cs_intros)
qed
qed (auto simp: cf_la_of_ra_components cat_cs_intros cat_cs_simps)
qed
lemma cf_la_of_ra_is_ntcf:
fixes F π Ξ·
defines "π β‘ cf_la_of_ra F π Ξ·"
assumes "π : π β¦β¦β©CβΞ±β β"
and "βc. c ββ©β ββ¦Objβ¦ βΉ F c ββ©β πβ¦Objβ¦"
and "βc. c ββ©β ββ¦Objβ¦ βΉ
universal_arrow_of π c (πβ¦ObjMapβ¦β¦cβ¦) (Ξ·β¦NTMapβ¦β¦cβ¦)"
and "βc c' h. h : c β¦βββ c' βΉ
πβ¦ArrMapβ¦β¦πβ¦ArrMapβ¦β¦hβ¦β¦ ββ©Aβββ (Ξ·β¦NTMapβ¦β¦cβ¦) = (Ξ·β¦NTMapβ¦β¦c'β¦) ββ©Aβββ h"
and "vfsequence Ξ·"
and "vcard Ξ· = 5β©β"
and "Ξ·β¦NTDomβ¦ = cf_id β"
and "Ξ·β¦NTCodβ¦ = π ββ©Cβ©F π"
and "Ξ·β¦NTDGDomβ¦ = β"
and "Ξ·β¦NTDGCodβ¦ = β"
and "vsv (Ξ·β¦NTMapβ¦)"
and "πβ©β (Ξ·β¦NTMapβ¦) = ββ¦Objβ¦"
shows "Ξ· : cf_id β β¦β©Cβ©F π ββ©Cβ©F π : β β¦β¦β©CβΞ±β β"
proof-
interpret π: is_functor Ξ± π β π by (rule assms(2))
have π: "π : β β¦β¦β©CβΞ±β π"
unfolding π_def
by (auto intro: cf_la_of_ra_is_functor[OF assms(2-5)[unfolded assms(1)]])
show "Ξ· : cf_id β β¦β©Cβ©F π ββ©Cβ©F π : β β¦β¦β©CβΞ±β β"
proof(rule is_ntcfI')
from assms(2) show "cf_id β : β β¦β¦β©CβΞ±β β"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms(2) π show "π ββ©Cβ©F π : β β¦β¦β©CβΞ±β β"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "Ξ·β¦NTMapβ¦β¦aβ¦ : cf_id ββ¦ObjMapβ¦β¦aβ¦ β¦βββ (π ββ©Cβ©F π)β¦ObjMapβ¦β¦aβ¦"
if "a ββ©β ββ¦Objβ¦" for a
using assms(2) π that π.universal_arrow_ofD(2)[OF assms(4)[OF that]]
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show
"Ξ·β¦NTMapβ¦β¦bβ¦ ββ©Aβββ cf_id ββ¦ArrMapβ¦β¦fβ¦ =
(π ββ©Cβ©F π)β¦ArrMapβ¦β¦fβ¦ ββ©Aβββ Ξ·β¦NTMapβ¦β¦aβ¦"
if "f : a β¦βββ b" for a b f
using assms(2) π that
by (cs_concl cs_simp: assms(5) cat_cs_simps cs_intro: cat_cs_intros)
qed (auto intro: assms(6-13))
qed
lemma cf_la_of_ra_is_unit:
fixes F π Ξ·
defines "π β‘ cf_la_of_ra F π Ξ·"
assumes "category Ξ± β"
and "category Ξ± π"
and "π : π β¦β¦β©CβΞ±β β"
and "βc. c ββ©β ββ¦Objβ¦ βΉ F c ββ©β πβ¦Objβ¦"
and "βc. c ββ©β ββ¦Objβ¦ βΉ
universal_arrow_of π c (πβ¦ObjMapβ¦β¦cβ¦) (Ξ·β¦NTMapβ¦β¦cβ¦)"
and "βc c' h. h : c β¦βββ c' βΉ
πβ¦ArrMapβ¦β¦πβ¦ArrMapβ¦β¦hβ¦β¦ ββ©Aβββ (Ξ·β¦NTMapβ¦β¦cβ¦) = (Ξ·β¦NTMapβ¦β¦c'β¦) ββ©Aβββ h"
and "vfsequence Ξ·"
and "vcard Ξ· = 5β©β"
and "Ξ·β¦NTDomβ¦ = cf_id β"
and "Ξ·β¦NTCodβ¦ = π ββ©Cβ©F π"
and "Ξ·β¦NTDGDomβ¦ = β"
and "Ξ·β¦NTDGCodβ¦ = β"
and "vsv (Ξ·β¦NTMapβ¦)"
and "πβ©β (Ξ·β¦NTMapβ¦) = ββ¦Objβ¦"
shows "cf_adjunction_of_unit Ξ± π π Ξ· : π ββ©Cβ©F π : β βββ©CβΞ±β π"
and "Ξ·β©C (cf_adjunction_of_unit Ξ± π π Ξ·) = Ξ·"
proof-
note π = cf_la_of_ra_is_functor[
where F=F and Ξ·=Ξ·, OF assms(4-7)[unfolded π_def], simplified
]
note Ξ· = cf_la_of_ra_is_ntcf[OF assms(4-15)[unfolded π_def], simplified]
show "cf_adjunction_of_unit Ξ± π π Ξ· : π ββ©Cβ©F π : β βββ©CβΞ±β π"
and "Ξ·β©C (cf_adjunction_of_unit Ξ± π π Ξ·) = Ξ·"
by
(
intro
cf_adjunction_of_unit_is_cf_adjunction
[
OF assms(2,3) π assms(4) Ξ· assms(6)[unfolded π_def],
simplified,
folded π_def
]
)+
qed
subsectionβΉ
Construction of an adjunction from universal morphisms
from functors to objects
βΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉ
The subsection presents the construction of an adjunction given
a structured collection of universal morphisms from functors to objects.
The content of this subsection follows the statement and the proof
of Theorem 2-iii in Chapter IV-1 in \cite{mac_lane_categories_2010}.
βΊ
definition cf_adjunction_of_counit :: "V β V β V β V β V"
where "cf_adjunction_of_counit Ξ± π π Ξ΅ =
op_cf_adj (cf_adjunction_of_unit Ξ± (op_cf π) (op_cf π) (op_ntcf Ξ΅))"
textβΉComponents.βΊ
lemma cf_adjunction_of_counit_components:
shows "cf_adjunction_of_counit Ξ± π π Ξ΅β¦AdjLeftβ¦ = op_cf (op_cf π)"
and "cf_adjunction_of_counit Ξ± π π Ξ΅β¦AdjRightβ¦ = op_cf (op_cf π)"
and "cf_adjunction_of_counit Ξ± π π Ξ΅β¦AdjNTβ¦ = op_cf_adj_nt
(op_cf πβ¦HomDomβ¦)
(op_cf πβ¦HomCodβ¦)
(cf_adjunction_AdjNT_of_unit Ξ± (op_cf π) (op_cf π) (op_ntcf Ξ΅))"
unfolding
cf_adjunction_of_counit_def
op_cf_adj_components
cf_adjunction_of_unit_components
by (simp_all add: cat_op_simps)
subsubsectionβΉNatural transformation mapβΊ
lemma cf_adjunction_of_counit_NTMap_vsv:
"vsv (cf_adjunction_of_counit Ξ± π π Ξ΅β¦AdjNTβ¦β¦NTMapβ¦)"
unfolding cf_adjunction_of_counit_components by (rule inv_ntcf_NTMap_vsv)
subsubsectionβΉ
An adjunction constructed from universal morphisms
from functors to objects is an adjunction
βΊ
lemma cf_adjunction_of_counit_is_cf_adjunction:
assumes "category Ξ± β"
and "category Ξ± π"
and "π : β β¦β¦β©CβΞ±β π"
and "π : π β¦β¦β©CβΞ±β β"
and "Ξ΅ : π ββ©Cβ©F π β¦β©Cβ©F cf_id π : π β¦β¦β©CβΞ±β π"
and "βx. x ββ©β πβ¦Objβ¦ βΉ universal_arrow_fo π x (πβ¦ObjMapβ¦β¦xβ¦) (Ξ΅β¦NTMapβ¦β¦xβ¦)"
shows "cf_adjunction_of_counit Ξ± π π Ξ΅ : π ββ©Cβ©F π : β βββ©CβΞ±β π"
and "Ξ΅β©C (cf_adjunction_of_counit Ξ± π π Ξ΅) = Ξ΅"
and "πβ©β (cf_adjunction_of_counit Ξ± π π Ξ΅β¦AdjNTβ¦β¦NTMapβ¦) =
(op_cat β Γβ©C π)β¦Objβ¦"
and "βc d. β¦ c ββ©β ββ¦Objβ¦; d ββ©β πβ¦Objβ¦ β§ βΉ
cf_adjunction_of_counit Ξ± π π Ξ΅β¦AdjNTβ¦β¦NTMapβ¦β¦c, dβ¦β©β =
(umap_fo π d (πβ¦ObjMapβ¦β¦dβ¦) (Ξ΅β¦NTMapβ¦β¦dβ¦) c)Β―β©Sβ©eβ©t"
proof-
interpret β: category Ξ± β by (rule assms(1))
interpret π: category Ξ± π by (rule assms(2))
interpret π: is_functor Ξ± β π π by (rule assms(3))
interpret π: is_functor Ξ± π β π by (rule assms(4))
interpret Ξ΅: is_ntcf Ξ± π π βΉπ ββ©Cβ©F πβΊ βΉcf_id πβΊ Ξ΅ by (rule assms(5))
note cf_adjunction_of_counit_def' =
cf_adjunction_of_counit_def[where π=π, unfolded π.cf_HomDom π.cf_HomCod]
have ua:
"universal_arrow_of (op_cf π) x (op_cf πβ¦ObjMapβ¦β¦xβ¦) (op_ntcf Ξ΅β¦NTMapβ¦β¦xβ¦)"
if "x ββ©β op_cat πβ¦Objβ¦" for x
using that unfolding cat_op_simps by (rule assms(6))
let ?aou = βΉcf_adjunction_of_unit Ξ± (op_cf π) (op_cf π) (op_ntcf Ξ΅)βΊ
from
cf_adjunction_of_unit_is_cf_adjunction
[
OF
π.category_op
β.category_op
π.is_functor_op
π.is_functor_op
Ξ΅.is_ntcf_op[unfolded cat_op_simps]
ua,
simplified cf_adjunction_of_counit_def[symmetric]
]
have aou: "?aou : op_cf π ββ©Cβ©F op_cf π : op_cat π βββ©CβΞ±β op_cat β"
and Ξ·_aou: "Ξ·β©C ?aou = op_ntcf Ξ΅"
by auto
interpret aou:
is_cf_adjunction Ξ± βΉop_cat πβΊ βΉop_cat ββΊ βΉop_cf πβΊ βΉop_cf πβΊ ?aou
by (rule aou)
from Ξ·_aou have
"op_ntcf (Ξ·β©C ?aou) = op_ntcf (op_ntcf Ξ΅)"
by simp
then show "Ξ΅β©C (cf_adjunction_of_counit Ξ± π π Ξ΅) = Ξ΅"
unfolding
Ξ΅.ntcf_op_ntcf_op_ntcf
is_cf_adjunction.op_ntcf_cf_adjunction_unit[OF aou]
cf_adjunction_of_counit_def'[symmetric]
by (simp add: cat_op_simps)
show aoc_Ξ΅: "cf_adjunction_of_counit Ξ± π π Ξ΅ : π ββ©Cβ©F π : β βββ©CβΞ±β π"
by
(
rule
is_cf_adjunction_op[
OF aou, folded cf_adjunction_of_counit_def', unfolded cat_op_simps
]
)
interpret aoc_Ξ΅: is_cf_adjunction Ξ± β π π π βΉcf_adjunction_of_counit Ξ± π π Ξ΅βΊ
by (rule aoc_Ξ΅)
from aoc_Ξ΅.NT.is_ntcf_axioms show
"πβ©β (cf_adjunction_of_counit Ξ± π π Ξ΅β¦AdjNTβ¦β¦NTMapβ¦) = (op_cat β Γβ©C π)β¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps)
show "βc d. β¦ c ββ©β ββ¦Objβ¦; d ββ©β πβ¦Objβ¦ β§ βΉ
cf_adjunction_of_counit Ξ± π π Ξ΅β¦AdjNTβ¦β¦NTMapβ¦β¦c, dβ¦β©β =
(umap_fo π d (πβ¦ObjMapβ¦β¦dβ¦) (Ξ΅β¦NTMapβ¦β¦dβ¦) c)Β―β©Sβ©eβ©t"
proof-
fix c d assume prems: "c ββ©β ββ¦Objβ¦" "d ββ©β πβ¦Objβ¦"
from assms(1-4) prems have aou_dc:
"cf_adjunction_AdjNT_of_unit
Ξ± (op_cf π) (op_cf π) (op_ntcf Ξ΅)β¦NTMapβ¦β¦d, cβ¦β©β =
umap_fo π d (πβ¦ObjMapβ¦β¦dβ¦) (Ξ΅β¦NTMapβ¦β¦dβ¦) c"
by (cs_concl cs_simp: cat_op_simps adj_cs_simps cs_intro: cat_op_intros)
from assms(1-4) aou prems have ufo_Ξ΅_dc:
"umap_fo π d (πβ¦ObjMapβ¦β¦dβ¦) (Ξ΅β¦NTMapβ¦β¦dβ¦) c :
Homβ©Oβ©.β©CβΞ±βop_cat β(op_cf π-,-)β¦ObjMapβ¦β¦d, cβ¦β©β β¦β©iβ©sβ©oβcat_Set Ξ±β
Homβ©Oβ©.β©CβΞ±βop_cat π(-,op_cf π-)β¦ObjMapβ¦β¦d, cβ¦β©β"
by
(
cs_concl
cs_simp:
aou_dc[symmetric] cf_adjunction_of_unit_components(3)[symmetric]
cs_intro:
is_iso_ntcf.iso_ntcf_is_arr_isomorphism'
adj_cs_intros
cat_cs_intros
cat_op_intros
cat_prod_cs_intros
)
from
assms(1-4)
aoc_Ξ΅[unfolded cf_adjunction_of_counit_def']
aou
prems
ufo_Ξ΅_dc
show
"cf_adjunction_of_counit Ξ± π π Ξ΅β¦AdjNTβ¦β¦NTMapβ¦β¦c, dβ¦β©β =
(umap_fo π d (πβ¦ObjMapβ¦β¦dβ¦) (Ξ΅β¦NTMapβ¦β¦dβ¦) c)Β―β©Sβ©eβ©t"
unfolding cf_adjunction_of_counit_def'
by
(
cs_concl
cs_simp: cat_op_simps adj_cs_simps cat_cs_simps cat_Set_cs_simps
cs_intro: adj_cs_intros cat_cs_intros cat_prod_cs_intros
)
qed
qed
subsectionβΉ
Construction of an adjunction from a functor and universal morphisms
from functors to objects
βΊ
textβΉ
The subsection presents the construction of an adjunction given
a functor and a structured collection of universal morphisms
from functors to objects.
The content of this subsection follows the statement and the proof
of Theorem 2-iv in Chapter IV-1 in \cite{mac_lane_categories_2010}.
βΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition cf_ra_of_la :: "(V β V) β V β V β V"
where "cf_ra_of_la F π Ξ΅ = op_cf (cf_la_of_ra F (op_cf π) (op_ntcf Ξ΅))"
subsubsectionβΉObject mapβΊ
lemma cf_ra_of_la_ObjMap_vsv[adj_cs_intros]: "vsv (cf_ra_of_la F π Ξ΅β¦ObjMapβ¦)"
unfolding cf_ra_of_la_def op_cf_components by (auto intro: adj_cs_intros)
lemma (in is_functor) cf_ra_of_la_ObjMap_vdomain:
"πβ©β (cf_ra_of_la F π Ξ΅β¦ObjMapβ¦) = π
β¦Objβ¦"
unfolding cf_ra_of_la_def cf_la_of_ra_components cat_op_simps
by (simp add: cat_cs_simps)
lemmas [adj_cs_simps] = is_functor.cf_ra_of_la_ObjMap_vdomain
lemma (in is_functor) cf_ra_of_la_ObjMap_app:
assumes "d ββ©β π
β¦Objβ¦"
shows "cf_ra_of_la F π Ξ΅β¦ObjMapβ¦β¦dβ¦ = F d"
using assms
unfolding cf_ra_of_la_def cf_la_of_ra_components cat_op_simps
by (simp add: cat_cs_simps)
lemmas [adj_cs_simps] = is_functor.cf_ra_of_la_ObjMap_app
subsubsectionβΉArrow mapβΊ
lemma cf_ra_of_la_ArrMap_app_unique:
assumes "π : β β¦β¦β©CβΞ±β π"
and "f : a β¦βπβ b"
and "universal_arrow_fo π a (cf_ra_of_la F π Ξ΅β¦ObjMapβ¦β¦aβ¦) (Ξ΅β¦NTMapβ¦β¦aβ¦)"
and "universal_arrow_fo π b (cf_ra_of_la F π Ξ΅β¦ObjMapβ¦β¦bβ¦) (Ξ΅β¦NTMapβ¦β¦bβ¦)"
shows "cf_ra_of_la F π Ξ΅β¦ArrMapβ¦β¦fβ¦ : F a β¦βββ F b"
and "f ββ©Aβπβ Ξ΅β¦NTMapβ¦β¦aβ¦ =
umap_fo π b (F b) (Ξ΅β¦NTMapβ¦β¦bβ¦) (F a)β¦ArrValβ¦β¦cf_ra_of_la F π Ξ΅β¦ArrMapβ¦β¦fβ¦β¦"
and "βf'.
β¦
f' : F a β¦βββ F b;
f ββ©Aβπβ Ξ΅β¦NTMapβ¦β¦aβ¦ = umap_fo π b (F b) (Ξ΅β¦NTMapβ¦β¦bβ¦) (F a)β¦ArrValβ¦β¦f'β¦
β§ βΉ cf_ra_of_la F π Ξ΅β¦ArrMapβ¦β¦fβ¦ = f'"
proof-
interpret π: is_functor Ξ± β π π by (rule assms(1))
from assms(2) have op_f: "f : b β¦βop_cat πβ a" unfolding cat_op_simps by simp
let ?lara = βΉcf_la_of_ra F (op_cf π) (op_ntcf Ξ΅)βΊ
have lara_ObjMap_eq_op: "?laraβ¦ObjMapβ¦ = (op_cf ?laraβ¦ObjMapβ¦)"
and lara_ArrMap_eq_op: "?laraβ¦ArrMapβ¦ = (op_cf ?laraβ¦ArrMapβ¦)"
unfolding cat_op_simps by simp_all
note ua_Ξ·_a = π.universal_arrow_foD[OF assms(3)]
and ua_Ξ·_b = π.universal_arrow_foD[OF assms(4)]
from assms(1,2) ua_Ξ·_a(2) have [cat_op_simps]:
"Ξ΅β¦NTMapβ¦β¦aβ¦ ββ©Aβop_cat πβ f = f ββ©Aβπβ Ξ΅β¦NTMapβ¦β¦aβ¦"
by (cs_concl cs_simp: cat_cs_simps cat_op_simps)
show "cf_ra_of_la F π Ξ΅β¦ArrMapβ¦β¦fβ¦ : F a β¦βββ F b"
and "f ββ©Aβπβ Ξ΅β¦NTMapβ¦β¦aβ¦ =
umap_fo π b (F b) (Ξ΅β¦NTMapβ¦β¦bβ¦) (F a)β¦ArrValβ¦β¦cf_ra_of_la F π Ξ΅β¦ArrMapβ¦β¦fβ¦β¦"
and "βf'.
β¦
f' : F a β¦βββ F b;
f ββ©Aβπβ Ξ΅β¦NTMapβ¦β¦aβ¦ = umap_fo π b (F b) (Ξ΅β¦NTMapβ¦β¦bβ¦) (F a)β¦ArrValβ¦β¦f'β¦
β§ βΉ cf_ra_of_la F π Ξ΅β¦ArrMapβ¦β¦fβ¦ = f'"
by
(
intro
cf_la_of_ra_ArrMap_app_unique
[
where Ξ·=βΉop_ntcf Ξ΅βΊ and F=F,
OF π.is_functor_op op_f,
unfolded
π.op_cf_universal_arrow_of
lara_ObjMap_eq_op
lara_ArrMap_eq_op,
folded cf_ra_of_la_def,
unfolded cat_op_simps,
OF assms(4,3)
]
)+
qed
lemma cf_ra_of_la_ArrMap_app_is_arr[adj_cs_intros]:
assumes "π : β β¦β¦β©CβΞ±β π"
and "f : a β¦βπβ b"
and "universal_arrow_fo π a (cf_ra_of_la F π Ξ΅β¦ObjMapβ¦β¦aβ¦) (Ξ΅β¦NTMapβ¦β¦aβ¦)"
and "universal_arrow_fo π b (cf_ra_of_la F π Ξ΅β¦ObjMapβ¦β¦bβ¦) (Ξ΅β¦NTMapβ¦β¦bβ¦)"
and "Fa = F a"
and "Fb = F b"
shows "cf_ra_of_la F π Ξ΅β¦ArrMapβ¦β¦fβ¦ : Fa β¦βββ Fb"
using assms(1-4) unfolding assms(5,6) by (rule cf_ra_of_la_ArrMap_app_unique)
subsubsectionβΉ
An adjunction constructed from a functor and universal morphisms
from functors to objects is an adjunction
βΊ
lemma op_cf_cf_la_of_ra_op[cat_op_simps]:
"op_cf (cf_la_of_ra F (op_cf π) (op_ntcf Ξ΅)) = cf_ra_of_la F π Ξ΅"
unfolding cf_ra_of_la_def by simp
lemma cf_ra_of_la_commute_op:
assumes "π : β β¦β¦β©CβΞ±β π"
and "βd. d ββ©β πβ¦Objβ¦ βΉ
universal_arrow_fo π d (cf_ra_of_la F π Ξ΅β¦ObjMapβ¦β¦dβ¦) (Ξ΅β¦NTMapβ¦β¦dβ¦)"
and "βd d' h. h : d β¦βπβ d' βΉ
Ξ΅β¦NTMapβ¦β¦d'β¦ ββ©Aβπβ πβ¦ArrMapβ¦β¦cf_ra_of_la F π Ξ΅β¦ArrMapβ¦β¦hβ¦β¦ =
h ββ©Aβπβ Ξ΅β¦NTMapβ¦β¦dβ¦"
and "h : c' β¦βπβ c"
shows "πβ¦ArrMapβ¦β¦cf_ra_of_la F π Ξ΅β¦ArrMapβ¦β¦hβ¦β¦ ββ©Aβop_cat πβ Ξ΅β¦NTMapβ¦β¦cβ¦ =
Ξ΅β¦NTMapβ¦β¦c'β¦ ββ©Aβop_cat πβ h"
proof-
interpret π: is_functor Ξ± β π π by (rule assms(1))
from assms(4) have c': "c' ββ©β πβ¦Objβ¦" and c: "c ββ©β πβ¦Objβ¦" by auto
note ua_Ξ·_c' = π.universal_arrow_foD[OF assms(2)[OF c']]
and ua_Ξ·_c = π.universal_arrow_foD[OF assms(2)[OF c]]
note rala_f = cf_ra_of_la_ArrMap_app_unique[
OF assms(1) assms(4) assms(2)[OF c'] assms(2)[OF c]
]
from assms(1) assms(4) ua_Ξ·_c'(2) ua_Ξ·_c(2) rala_f(1) show ?thesis
by
(
cs_concl
cs_simp: assms(3) cat_op_simps adj_cs_simps cat_cs_simps
cs_intro: cat_cs_intros
)
qed
lemma
assumes "π : β β¦β¦β©CβΞ±β π"
and "βd. d ββ©β πβ¦Objβ¦ βΉ F d ββ©β ββ¦Objβ¦"
and "βd. d ββ©β πβ¦Objβ¦ βΉ
universal_arrow_fo π d (cf_ra_of_la F π Ξ΅β¦ObjMapβ¦β¦dβ¦) (Ξ΅β¦NTMapβ¦β¦dβ¦)"
and "βd d' h. h : d β¦βπβ d' βΉ
Ξ΅β¦NTMapβ¦β¦d'β¦ ββ©Aβπβ πβ¦ArrMapβ¦β¦cf_ra_of_la F π Ξ΅β¦ArrMapβ¦β¦hβ¦β¦ =
h ββ©Aβπβ Ξ΅β¦NTMapβ¦β¦dβ¦"
shows cf_ra_of_la_is_functor: "cf_ra_of_la F π Ξ΅ : π β¦β¦β©CβΞ±β β"
and cf_la_of_ra_op_is_functor:
"cf_la_of_ra F (op_cf π) (op_ntcf Ξ΅) : op_cat π β¦β¦β©CβΞ±β op_cat β"
proof-
interpret π: is_functor Ξ± β π π by (rule assms(1))
have πh_Ξ΅c:
"πβ¦ArrMapβ¦β¦cf_ra_of_la F π Ξ΅β¦ArrMapβ¦β¦hβ¦β¦ ββ©Aβop_cat πβ Ξ΅β¦NTMapβ¦β¦cβ¦ =
Ξ΅β¦NTMapβ¦β¦c'β¦ ββ©Aβop_cat πβ h"
if "h : c' β¦βπβ c" for c c' h
proof-
from that have c': "c' ββ©β πβ¦Objβ¦" and c: "c ββ©β πβ¦Objβ¦" by auto
note ua_Ξ·_c' = π.universal_arrow_foD[OF assms(3)[OF c']]
and ua_Ξ·_c = π.universal_arrow_foD[OF assms(3)[OF c]]
note rala_f = cf_ra_of_la_ArrMap_app_unique[
OF assms(1) that assms(3)[OF c'] assms(3)[OF c]
]
from assms(1) that ua_Ξ·_c'(2) ua_Ξ·_c(2) rala_f(1) show ?thesis
by
(
cs_concl
cs_simp: assms(4) cat_op_simps adj_cs_simps cat_cs_simps
cs_intro: cat_cs_intros
)
qed
let ?lara = βΉcf_la_of_ra F (op_cf π) (op_ntcf Ξ΅)βΊ
have lara_ObjMap_eq_op: "?laraβ¦ObjMapβ¦ = (op_cf ?laraβ¦ObjMapβ¦)"
and lara_ArrMap_eq_op: "?laraβ¦ArrMapβ¦ = (op_cf ?laraβ¦ArrMapβ¦)"
by (simp_all add: cat_op_simps del: op_cf_cf_la_of_ra_op)
show "cf_la_of_ra F (op_cf π) (op_ntcf Ξ΅) : op_cat π β¦β¦β©CβΞ±β op_cat β"
by
(
intro cf_la_of_ra_is_functor
[
where F=F and Ξ·=βΉop_ntcf Ξ΅βΊ,
OF π.is_functor_op,
unfolded cat_op_simps,
OF assms(2),
simplified,
unfolded lara_ObjMap_eq_op lara_ArrMap_eq_op,
folded cf_ra_of_la_def,
OF assms(3) πh_Ξ΅c
]
)
from
is_functor.is_functor_op[
OF this, unfolded cat_op_simps, folded cf_ra_of_la_def
]
show "cf_ra_of_la F π Ξ΅ : π β¦β¦β©CβΞ±β β".
qed
lemma cf_ra_of_la_is_ntcf:
fixes F π Ξ΅
defines "π β‘ cf_ra_of_la F π Ξ΅"
assumes "π : β β¦β¦β©CβΞ±β π"
and "βd. d ββ©β πβ¦Objβ¦ βΉ F d ββ©β ββ¦Objβ¦"
and "βd. d ββ©β πβ¦Objβ¦ βΉ
universal_arrow_fo π d (πβ¦ObjMapβ¦β¦dβ¦) (Ξ΅β¦NTMapβ¦β¦dβ¦)"
and "βd d' h. h : d β¦βπβ d' βΉ
Ξ΅β¦NTMapβ¦β¦d'β¦ ββ©Aβπβ πβ¦ArrMapβ¦β¦πβ¦ArrMapβ¦β¦hβ¦β¦ = h ββ©Aβπβ Ξ΅β¦NTMapβ¦β¦dβ¦"
and "vfsequence Ξ΅"
and "vcard Ξ΅ = 5β©β"
and "Ξ΅β¦NTDomβ¦ = π ββ©Cβ©F π"
and "Ξ΅β¦NTCodβ¦ = cf_id π"
and "Ξ΅β¦NTDGDomβ¦ = π"
and "Ξ΅β¦NTDGCodβ¦ = π"
and "vsv (Ξ΅β¦NTMapβ¦)"
and "πβ©β (Ξ΅β¦NTMapβ¦) = πβ¦Objβ¦"
shows "Ξ΅ : π ββ©Cβ©F π β¦β©Cβ©F cf_id π : π β¦β¦β©CβΞ±β π"
proof-
interpret π: is_functor Ξ± β π π by (rule assms(2))
interpret π: is_functor Ξ± π β π
unfolding π_def
by (auto intro: cf_ra_of_la_is_functor[OF assms(2-5)[unfolded assms(1)]])
interpret op_Ξ΅: is_functor
Ξ± βΉop_cat πβΊ βΉop_cat ββΊ βΉcf_la_of_ra F (op_cf π) (op_ntcf Ξ΅)βΊ
by
(
intro cf_la_of_ra_op_is_functor[
where F=F and Ξ΅=Ξ΅, OF assms(2,3,4,5)[unfolded π_def], simplified
]
)
interpret Ξ΅: vfsequence Ξ΅ by (rule assms(6))
have [cat_op_simps]: "op_ntcf (op_ntcf Ξ΅) = Ξ΅"
proof(rule vsv_eqI)
have dom_lhs: "πβ©β (op_ntcf (op_ntcf Ξ΅)) = 5β©β"
unfolding op_ntcf_def by (simp add: nat_omega_simps)
from assms(7) show "πβ©β (op_ntcf (op_ntcf Ξ΅)) = πβ©β Ξ΅"
by (simp add: dom_lhs Ξ΅.vfsequence_vdomain)
have sup:
"op_ntcf (op_ntcf Ξ΅)β¦NTDomβ¦ = Ξ΅β¦NTDomβ¦"
"op_ntcf (op_ntcf Ξ΅)β¦NTCodβ¦ = Ξ΅β¦NTCodβ¦"
"op_ntcf (op_ntcf Ξ΅)β¦NTDGDomβ¦ = Ξ΅β¦NTDGDomβ¦"
"op_ntcf (op_ntcf Ξ΅)β¦NTDGCodβ¦ = Ξ΅β¦NTDGCodβ¦"
unfolding op_ntcf_components assms(8-11) cat_op_simps
by simp_all
show "a ββ©β πβ©β (op_ntcf (op_ntcf Ξ΅)) βΉ op_ntcf (op_ntcf Ξ΅)β¦aβ¦ = Ξ΅β¦aβ¦" for a
by (unfold dom_lhs, elim_in_numeral, fold nt_field_simps, unfold sup)
(simp_all add: cat_op_simps)
qed (auto simp: op_ntcf_def)
let ?lara = βΉcf_la_of_ra F (op_cf π) (op_ntcf Ξ΅)βΊ
have lara_ObjMap_eq_op: "?laraβ¦ObjMapβ¦ = (op_cf ?laraβ¦ObjMapβ¦)"
and lara_ArrMap_eq_op: "?laraβ¦ArrMapβ¦ = (op_cf ?laraβ¦ArrMapβ¦)"
by (simp_all add: cat_op_simps del: op_cf_cf_la_of_ra_op)
have seq: "vfsequence (op_ntcf Ξ΅)" unfolding op_ntcf_def by auto
have card: "vcard (op_ntcf Ξ΅) = 5β©β"
unfolding op_ntcf_def by (simp add: nat_omega_simps)
have op_cf_NTCod: "op_cf (Ξ΅β¦NTCodβ¦) = cf_id (op_cat π)"
unfolding assms(9) cat_op_simps by simp
from assms(2) have op_cf_NTDom:
"op_cf (Ξ΅β¦NTDomβ¦) = op_cf π ββ©Cβ©F cf_la_of_ra F (op_cf π) (op_ntcf Ξ΅)"
unfolding assms(8) cat_op_simps π_def
by (simp_all add: cat_op_simps cf_ra_of_la_def del: op_cf_cf_la_of_ra_op)
have "op_ntcf Ξ΅ :
cf_id (op_cat π) β¦β©Cβ©F op_cf π ββ©Cβ©F cf_la_of_ra F (op_cf π) (op_ntcf Ξ΅) :
op_cat π β¦β¦β©CβΞ±β op_cat π"
by
(
auto intro: cf_la_of_ra_is_ntcf
[
where F=F and Ξ·=βΉop_ntcf Ξ΅βΊ,
OF is_functor.is_functor_op[OF assms(2)],
unfolded cat_op_simps,
OF assms(3),
simplified,
unfolded
lara_ObjMap_eq_op
lara_ArrMap_eq_op
cf_ra_of_la_def[symmetric],
OF assms(4)[unfolded π_def],
simplified,
OF cf_ra_of_la_commute_op[
OF assms(2,4,5)[unfolded π_def], simplified
],
simplified,
OF seq card _ op_cf_NTDom _ _ assms(12),
unfolded assms(8-11,13) cat_op_simps
]
)
from is_ntcf.is_ntcf_op[OF this, unfolded cat_op_simps π_def[symmetric]] show
"Ξ΅ : π ββ©Cβ©F π β¦β©Cβ©F cf_id π : π β¦β¦β©CβΞ±β π".
qed
lemma cf_ra_of_la_is_counit:
fixes F π Ξ΅
defines "π β‘ cf_ra_of_la F π Ξ΅"
assumes "category Ξ± β"
and "category Ξ± π"
and "π : β β¦β¦β©CβΞ±β π"
and "βd. d ββ©β πβ¦Objβ¦ βΉ F d ββ©β ββ¦Objβ¦"
and "βd. d ββ©β πβ¦Objβ¦ βΉ
universal_arrow_fo π d (πβ¦ObjMapβ¦β¦dβ¦) (Ξ΅β¦NTMapβ¦β¦dβ¦)"
and "βd d' h. h : d β¦βπβ d' βΉ
Ξ΅β¦NTMapβ¦β¦d'β¦ ββ©Aβπβ πβ¦ArrMapβ¦β¦πβ¦ArrMapβ¦β¦hβ¦β¦ = h ββ©Aβπβ Ξ΅β¦NTMapβ¦β¦dβ¦"
and "vfsequence Ξ΅"
and "vcard Ξ΅ = 5β©β"
and "Ξ΅β¦NTDomβ¦ = π ββ©Cβ©F π"
and "Ξ΅β¦NTCodβ¦ = cf_id π"
and "Ξ΅β¦NTDGDomβ¦ = π"
and "Ξ΅β¦NTDGCodβ¦ = π"
and "vsv (Ξ΅β¦NTMapβ¦)"
and "πβ©β (Ξ΅β¦NTMapβ¦) = πβ¦Objβ¦"
shows "cf_adjunction_of_counit Ξ± π π Ξ΅ : π ββ©Cβ©F π : β βββ©CβΞ±β π"
and "Ξ΅β©C (cf_adjunction_of_counit Ξ± π π Ξ΅) = Ξ΅"
proof-
note π = cf_ra_of_la_is_functor[
where F=F and Ξ΅=Ξ΅, OF assms(4-7)[unfolded π_def], simplified
]
note Ξ΅ = cf_ra_of_la_is_ntcf[OF assms(4-15)[unfolded π_def], simplified]
show "cf_adjunction_of_counit Ξ± π π Ξ΅ : π ββ©Cβ©F π : β βββ©CβΞ±β π"
and "Ξ΅β©C (cf_adjunction_of_counit Ξ± π π Ξ΅) = Ξ΅"
by
(
intro
cf_adjunction_of_counit_is_cf_adjunction
[
OF assms(2,3,4) π Ξ΅ assms(6)[unfolded π_def],
simplified,
folded π_def
]
)+
qed
subsectionβΉConstruction of an adjunction from the counit-unit equationsβΊ
textβΉ
The subsection presents the construction of an adjunction given
two natural transformations satisfying counit-unit equations.
The content of this subsection follows the statement and the proof
of Theorem 2-v in Chapter IV-1 in \cite{mac_lane_categories_2010}.
βΊ
lemma counit_unit_is_cf_adjunction:
assumes "category Ξ± β"
and "category Ξ± π"
and "π : β β¦β¦β©CβΞ±β π"
and "π : π β¦β¦β©CβΞ±β β"
and "Ξ· : cf_id β β¦β©Cβ©F π ββ©Cβ©F π : β β¦β¦β©CβΞ±β β"
and "Ξ΅ : π ββ©Cβ©F π β¦β©Cβ©F cf_id π : π β¦β¦β©CβΞ±β π"
and "(π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F Ξ΅) ββ©Nβ©Tβ©Cβ©F (Ξ· ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π) = ntcf_id π"
and "(Ξ΅ ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π) ββ©Nβ©Tβ©Cβ©F (π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F Ξ·) = ntcf_id π"
shows "cf_adjunction_of_unit Ξ± π π Ξ· : π ββ©Cβ©F π : β βββ©CβΞ±β π"
and "Ξ·β©C (cf_adjunction_of_unit Ξ± π π Ξ·) = Ξ·"
and "Ξ΅β©C (cf_adjunction_of_unit Ξ± π π Ξ·) = Ξ΅"
proof-
interpret β: category Ξ± β by (rule assms(1))
interpret π: category Ξ± π by (rule assms(2))
interpret π: is_functor Ξ± β π π by (rule assms(3))
interpret π: is_functor Ξ± π β π by (rule assms(4))
interpret Ξ·: is_ntcf Ξ± β β βΉcf_id ββΊ βΉπ ββ©Cβ©F πβΊ Ξ· by (rule assms(5))
interpret Ξ΅: is_ntcf Ξ± π π βΉπ ββ©Cβ©F πβΊ βΉcf_id πβΊ Ξ΅ by (rule assms(6))
have πΞ΅x_Ξ·πx[cat_cs_simps]:
"πβ¦ArrMapβ¦β¦Ξ΅β¦NTMapβ¦β¦xβ¦β¦ ββ©Aβββ Ξ·β¦NTMapβ¦β¦πβ¦ObjMapβ¦β¦xβ¦β¦ = ββ¦CIdβ¦β¦πβ¦ObjMapβ¦β¦xβ¦β¦"
if "x ββ©β πβ¦Objβ¦" for x
proof-
from assms(7) have
"((π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F Ξ΅) ββ©Nβ©Tβ©Cβ©F (Ξ· ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π))β¦NTMapβ¦β¦xβ¦ = ntcf_id πβ¦NTMapβ¦β¦xβ¦"
by simp
from this assms(1-6) that show
"πβ¦ArrMapβ¦β¦Ξ΅β¦NTMapβ¦β¦xβ¦β¦ ββ©Aβββ Ξ·β¦NTMapβ¦β¦πβ¦ObjMapβ¦β¦xβ¦β¦ =
ββ¦CIdβ¦β¦πβ¦ObjMapβ¦β¦xβ¦β¦"
by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
have [cat_cs_simps]:
"πβ¦ArrMapβ¦β¦Ξ΅β¦NTMapβ¦β¦xβ¦β¦ ββ©Aβββ (Ξ·β¦NTMapβ¦β¦πβ¦ObjMapβ¦β¦xβ¦β¦ ββ©Aβββ f) =
ββ¦CIdβ¦β¦πβ¦ObjMapβ¦β¦xβ¦β¦ ββ©Aβββ f"
if "x ββ©β πβ¦Objβ¦" and "f : a β¦βββ πβ¦ObjMapβ¦β¦xβ¦" for x f a
using assms(1-6) that
by (intro β.cat_assoc_helper)
(cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
have [cat_cs_simps]:
"Ξ΅β¦NTMapβ¦β¦πβ¦ObjMapβ¦β¦xβ¦β¦ ββ©Aβπβ πβ¦ArrMapβ¦β¦Ξ·β¦NTMapβ¦β¦xβ¦β¦ = πβ¦CIdβ¦β¦πβ¦ObjMapβ¦β¦xβ¦β¦"
if "x ββ©β ββ¦Objβ¦" for x
proof-
from assms(8) have
"((Ξ΅ ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π) ββ©Nβ©Tβ©Cβ©F (π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F Ξ·))β¦NTMapβ¦β¦xβ¦ = ntcf_id πβ¦NTMapβ¦β¦xβ¦"
by simp
from this assms(1-6) that show
"Ξ΅β¦NTMapβ¦β¦πβ¦ObjMapβ¦β¦xβ¦β¦ ββ©Aβπβ πβ¦ArrMapβ¦β¦Ξ·β¦NTMapβ¦β¦xβ¦β¦ = πβ¦CIdβ¦β¦πβ¦ObjMapβ¦β¦xβ¦β¦"
by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
have ua_πx_Ξ·x: "universal_arrow_of π x (πβ¦ObjMapβ¦β¦xβ¦) (Ξ·β¦NTMapβ¦β¦xβ¦)"
if "x ββ©β ββ¦Objβ¦" for x
proof(intro is_functor.universal_arrow_ofI)
from assms(3) that show "πβ¦ObjMapβ¦β¦xβ¦ ββ©β πβ¦Objβ¦"
by (cs_concl cs_intro: cat_cs_intros)
from assms(3-6) that show "Ξ·β¦NTMapβ¦β¦xβ¦ : x β¦βββ πβ¦ObjMapβ¦β¦πβ¦ObjMapβ¦β¦xβ¦β¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
fix r' u' assume prems': "r' ββ©β πβ¦Objβ¦" "u' : x β¦βββ πβ¦ObjMapβ¦β¦r'β¦"
show "β!f'.
f' : πβ¦ObjMapβ¦β¦xβ¦ β¦βπβ r' β§
u' = umap_of π x (πβ¦ObjMapβ¦β¦xβ¦) (Ξ·β¦NTMapβ¦β¦xβ¦) r'β¦ArrValβ¦β¦f'β¦"
proof(intro ex1I conjI; (elim conjE)?)
from assms(3-6) that prems' show
"Ξ΅β¦NTMapβ¦β¦r'β¦ ββ©Aβπβ πβ¦ArrMapβ¦β¦u'β¦ : πβ¦ObjMapβ¦β¦xβ¦ β¦βπβ r'"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms(3-6) prems' have ππu':
"(π ββ©Cβ©F π)β¦ArrMapβ¦β¦u'β¦ = πβ¦ArrMapβ¦β¦πβ¦ArrMapβ¦β¦u'β¦β¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
note [cat_cs_simps] =
Ξ·.ntcf_Comp_commute[symmetric, OF prems'(2), unfolded ππu']
from assms(3-6) that prems' show
"u' =
umap_of π x (πβ¦ObjMapβ¦β¦xβ¦) (Ξ·β¦NTMapβ¦β¦xβ¦) r'β¦ArrValβ¦β¦Ξ΅β¦NTMapβ¦β¦r'β¦ ββ©Aβπβ
πβ¦ArrMapβ¦β¦u'β¦β¦"
by
(
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
)
fix f' assume prems'':
"f' : πβ¦ObjMapβ¦β¦xβ¦ β¦βπβ r'"
"u' = umap_of π x (πβ¦ObjMapβ¦β¦xβ¦) (Ξ·β¦NTMapβ¦β¦xβ¦) r'β¦ArrValβ¦β¦f'β¦"
from prems''(2,1) assms(3-6) that have u'_def:
"u' = πβ¦ArrMapβ¦β¦f'β¦ ββ©Aβββ Ξ·β¦NTMapβ¦β¦xβ¦"
by
(
cs_prems
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
)
from
Ξ΅.ntcf_Comp_commute[OF prems''(1)]
assms(3-6)
prems''(1)
have [cat_cs_simps]:
"Ξ΅β¦NTMapβ¦β¦r'β¦ ββ©Aβπβ πβ¦ArrMapβ¦β¦πβ¦ArrMapβ¦β¦f'β¦β¦ =
f' ββ©Aβπβ Ξ΅β¦NTMapβ¦β¦πβ¦ObjMapβ¦β¦xβ¦β¦"
by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
have [cat_cs_simps]:
"Ξ΅β¦NTMapβ¦β¦r'β¦ ββ©Aβπβ (πβ¦ArrMapβ¦β¦πβ¦ArrMapβ¦β¦f'β¦β¦ ββ©Aβπβ f) =
(f' ββ©Aβπβ Ξ΅β¦NTMapβ¦β¦πβ¦ObjMapβ¦β¦xβ¦β¦) ββ©Aβπβ f"
if "f : a β¦βπβ πβ¦ObjMapβ¦β¦πβ¦ObjMapβ¦β¦πβ¦ObjMapβ¦β¦xβ¦β¦β¦" for f a
using assms(1-6) prems''(1) prems' that
by (intro π.cat_assoc_helper)
(
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
)+
from prems''(2,1) assms(3-6) that show
"f' = Ξ΅β¦NTMapβ¦β¦r'β¦ ββ©Aβπβ πβ¦ArrMapβ¦β¦u'β¦"
unfolding u'_def
by
(
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
)
qed
qed (auto intro: cat_cs_intros)
show aou: "cf_adjunction_of_unit Ξ± π π Ξ· : π ββ©Cβ©F π : β βββ©CβΞ±β π"
by (intro cf_adjunction_of_unit_is_cf_adjunction ua_πx_Ξ·x assms(1-5))
from β.category_axioms π.category_axioms show "Ξ·β©C (cf_adjunction_of_unit Ξ± π π Ξ·) = Ξ·"
by (cs_concl cs_intro: cf_adjunction_of_unit_is_cf_adjunction assms(1-5) ua_πx_Ξ·x)
interpret aou: is_cf_adjunction Ξ± β π π π βΉcf_adjunction_of_unit Ξ± π π Ξ·βΊ
by (rule aou)
show "Ξ΅β©C (cf_adjunction_of_unit Ξ± π π Ξ·) = Ξ΅"
proof(rule ntcf_eqI)
show Ξ΅_Ξ·: "Ξ΅β©C (cf_adjunction_of_unit Ξ± π π Ξ·) :
π ββ©Cβ©F π β¦β©Cβ©F cf_id π : π β¦β¦β©CβΞ±β π"
by (rule aou.cf_adjunction_counit_is_ntcf)
from assms(1-6) Ξ΅_Ξ· have dom_lhs:
"πβ©β (Ξ΅β©C (cf_adjunction_of_unit Ξ± π π Ξ·)β¦NTMapβ¦) = πβ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps)
from assms(1-6) Ξ΅_Ξ· have dom_rhs: "πβ©β (Ξ΅β¦NTMapβ¦) = πβ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps)
show "Ξ΅β©C (cf_adjunction_of_unit Ξ± π π Ξ·)β¦NTMapβ¦ = Ξ΅β¦NTMapβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix a assume "a ββ©β πβ¦Objβ¦"
with aou.is_cf_adjunction_axioms assms(1-6) show
"Ξ΅β©C (cf_adjunction_of_unit Ξ± π π Ξ·)β¦NTMapβ¦β¦aβ¦ = Ξ΅β¦NTMapβ¦β¦aβ¦"
by
(
cs_concl
cs_intro:
cat_arrow_cs_intros
cat_op_intros
cat_cs_intros
cat_prod_cs_intros
cs_simp:
aou.cf_adj_umap_of_unit'[symmetric]
cat_Set_the_inverse[symmetric]
adj_cs_simps cat_cs_simps cat_op_simps
)
qed (auto simp: adj_cs_intros)
qed (auto simp: assms)
qed
lemma counit_unit_cf_adjunction_of_counit_is_cf_adjunction:
assumes "category Ξ± β"
and "category Ξ± π"
and "π : β β¦β¦β©CβΞ±β π"
and "π : π β¦β¦β©CβΞ±β β"
and "Ξ· : cf_id β β¦β©Cβ©F π ββ©Cβ©F π : β β¦β¦β©CβΞ±β β"
and "Ξ΅ : π ββ©Cβ©F π β¦β©Cβ©F cf_id π : π β¦β¦β©CβΞ±β π"
and "(π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F Ξ΅) ββ©Nβ©Tβ©Cβ©F (Ξ· ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π) = ntcf_id π"
and "(Ξ΅ ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π) ββ©Nβ©Tβ©Cβ©F (π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F Ξ·) = ntcf_id π"
shows "cf_adjunction_of_counit Ξ± π π Ξ΅ : π ββ©Cβ©F π : β βββ©CβΞ±β π"
and "Ξ·β©C (cf_adjunction_of_counit Ξ± π π Ξ΅) = Ξ·"
and "Ξ΅β©C (cf_adjunction_of_counit Ξ± π π Ξ΅) = Ξ΅"
proof-
interpret β: category Ξ± β by (rule assms(1))
interpret π: category Ξ± π by (rule assms(2))
interpret π: is_functor Ξ± β π π by (rule assms(3))
interpret π: is_functor Ξ± π β π by (rule assms(4))
interpret Ξ·: is_ntcf Ξ± β β βΉcf_id ββΊ βΉπ ββ©Cβ©F πβΊ Ξ· by (rule assms(5))
interpret Ξ΅: is_ntcf Ξ± π π βΉπ ββ©Cβ©F πβΊ βΉcf_id πβΊ Ξ΅ by (rule assms(6))
have unit_op: "cf_adjunction_of_unit Ξ± (op_cf π) (op_cf π) (op_ntcf Ξ΅) :
op_cf π ββ©Cβ©F op_cf π : op_cat π βββ©CβΞ±β op_cat β"
by (rule counit_unit_is_cf_adjunction(1)[where Ξ΅=βΉop_ntcf Ξ·βΊ])
(
cs_concl
cs_simp:
cat_op_simps cat_cs_simps
π.cf_ntcf_id_op_cf
π.cf_ntcf_id_op_cf
op_ntcf_ntcf_vcomp[symmetric]
op_ntcf_ntcf_cf_comp[symmetric]
op_ntcf_cf_ntcf_comp[symmetric]
assms(7,8)
cs_intro: cat_op_intros cat_cs_intros
)+
then show aou: "cf_adjunction_of_counit Ξ± π π Ξ΅ : π ββ©Cβ©F π : β βββ©CβΞ±β π"
unfolding cf_adjunction_of_counit_def
by
(
subst π.cf_op_cf_op_cf[symmetric],
subst π.cf_op_cf_op_cf[symmetric],
subst β.cat_op_cat_op_cat[symmetric],
subst π.cat_op_cat_op_cat[symmetric],
rule is_cf_adjunction_op
)
interpret aou: is_cf_adjunction Ξ± β π π π βΉcf_adjunction_of_counit Ξ± π π Ξ΅βΊ
by (rule aou)
show "Ξ·β©C (cf_adjunction_of_counit Ξ± π π Ξ΅) = Ξ·"
unfolding cf_adjunction_of_counit_def
by
(
cs_concl_step is_cf_adjunction.op_ntcf_cf_adjunction_counit[symmetric],
rule unit_op,
cs_concl_step counit_unit_is_cf_adjunction(3)[where Ξ΅=βΉop_ntcf Ξ·βΊ],
insert β.category_op π.category_op
)
(
cs_concl
cs_simp:
cat_op_simps cat_cs_simps
π.cf_ntcf_id_op_cf
π.cf_ntcf_id_op_cf
op_ntcf_ntcf_vcomp[symmetric]
op_ntcf_ntcf_cf_comp[symmetric]
op_ntcf_cf_ntcf_comp[symmetric]
assms(7,8)
cs_intro: cat_op_intros cat_cs_intros
)+
show "Ξ΅β©C (cf_adjunction_of_counit Ξ± π π Ξ΅) = Ξ΅"
unfolding cf_adjunction_of_counit_def
by
(
cs_concl_step is_cf_adjunction.op_ntcf_cf_adjunction_unit[symmetric],
rule unit_op,
cs_concl_step counit_unit_is_cf_adjunction(2)[where Ξ΅=βΉop_ntcf Ξ·βΊ],
insert β.category_op π.category_op
)
(
cs_concl
cs_simp:
cat_op_simps cat_cs_simps
π.cf_ntcf_id_op_cf
π.cf_ntcf_id_op_cf
op_ntcf_ntcf_vcomp[symmetric]
op_ntcf_ntcf_cf_comp[symmetric]
op_ntcf_cf_ntcf_comp[symmetric]
assms(7,8)
cs_intro: cat_op_intros cat_cs_intros
)+
qed
subsectionβΉAdjoints are unique up to isomorphismβΊ
textβΉ
The content of the following subsection is based predominantly on
the statement and the proof of Corollary 1 in
Chapter IV-1 in \cite{mac_lane_categories_2010}. However, similar
results can also be found in section 4 in \cite{riehl_category_2016}
and in subsection 2.1 in \cite{bodo_categories_1970}.
βΊ
subsubsectionβΉDefinitions and elementary propertiesβΊ
definition cf_adj_LR_iso :: "V β V β V β V β V β V β V β V"
where "cf_adj_LR_iso β π π π Ξ¦ π' Ξ¨ =
[
(
Ξ»xββ©βββ¦Objβ¦. THE f'.
let
Ξ· = Ξ·β©C Ξ¦;
Ξ·' = Ξ·β©C Ξ¨;
πx = πβ¦ObjMapβ¦β¦xβ¦;
π'x = π'β¦ObjMapβ¦β¦xβ¦
in
f' : πx β¦βπβ π'x β§
Ξ·'β¦NTMapβ¦β¦xβ¦ = umap_of π x (πx) (Ξ·β¦NTMapβ¦β¦xβ¦) (π'x)β¦ArrValβ¦β¦f'β¦
),
π,
π',
β,
π
]β©β"
definition cf_adj_RL_iso :: "V β V β V β V β V β V β V β V"
where "cf_adj_RL_iso β π π π Ξ¦ π' Ξ¨ =
[
(
Ξ»xββ©βπβ¦Objβ¦. THE f'.
let
Ξ΅ = Ξ΅β©C Ξ¦;
Ξ΅' = Ξ΅β©C Ξ¨;
πx = πβ¦ObjMapβ¦β¦xβ¦;
π'x = π'β¦ObjMapβ¦β¦xβ¦
in
f' : π'x β¦βββ πx β§
Ξ΅'β¦NTMapβ¦β¦xβ¦ = umap_fo π x πx (Ξ΅β¦NTMapβ¦β¦xβ¦) π'xβ¦ArrValβ¦β¦f'β¦
),
π',
π,
π,
β
]β©β"
textβΉComponents.βΊ
lemma cf_adj_LR_iso_components:
shows "cf_adj_LR_iso β π π π Ξ¦ π' Ξ¨β¦NTMapβ¦ =
(
Ξ»xββ©βββ¦Objβ¦. THE f'.
let
Ξ· = Ξ·β©C Ξ¦;
Ξ·' = Ξ·β©C Ξ¨;
πx = πβ¦ObjMapβ¦β¦xβ¦;
π'x = π'β¦ObjMapβ¦β¦xβ¦
in
f' : πx β¦βπβ π'x β§
Ξ·'β¦NTMapβ¦β¦xβ¦ = umap_of π x πx (Ξ·β¦NTMapβ¦β¦xβ¦) π'xβ¦ArrValβ¦β¦f'β¦
)"
and [adj_cs_simps]: "cf_adj_LR_iso β π π π Ξ¦ π' Ξ¨β¦NTDomβ¦ = π"
and [adj_cs_simps]: "cf_adj_LR_iso β π π π Ξ¦ π' Ξ¨β¦NTCodβ¦ = π'"
and [adj_cs_simps]: "cf_adj_LR_iso β π π π Ξ¦ π' Ξ¨β¦NTDGDomβ¦ = β"
and [adj_cs_simps]: "cf_adj_LR_iso β π π π Ξ¦ π' Ξ¨β¦NTDGCodβ¦ = π"
unfolding cf_adj_LR_iso_def nt_field_simps
by (simp_all add: nat_omega_simps)
lemma cf_adj_RL_iso_components:
shows "cf_adj_RL_iso β π π π Ξ¦ π' Ξ¨β¦NTMapβ¦ =
(
Ξ»xββ©βπβ¦Objβ¦. THE f'.
let
Ξ΅ = Ξ΅β©C Ξ¦;
Ξ΅' = Ξ΅β©C Ξ¨;
πx = πβ¦ObjMapβ¦β¦xβ¦;
π'x = π'β¦ObjMapβ¦β¦xβ¦
in
f' : π'x β¦βββ πx β§
Ξ΅'β¦NTMapβ¦β¦xβ¦ = umap_fo π x πx (Ξ΅β¦NTMapβ¦β¦xβ¦) π'xβ¦ArrValβ¦β¦f'β¦
)"
and [adj_cs_simps]: "cf_adj_RL_iso β π π π Ξ¦ π' Ξ¨β¦NTDomβ¦ = π'"
and [adj_cs_simps]: "cf_adj_RL_iso β π π π Ξ¦ π' Ξ¨β¦NTCodβ¦ = π"
and [adj_cs_simps]: "cf_adj_RL_iso β π π π Ξ¦ π' Ξ¨β¦NTDGDomβ¦ = π"
and [adj_cs_simps]: "cf_adj_RL_iso β π π π Ξ¦ π' Ξ¨β¦NTDGCodβ¦ = β"
unfolding cf_adj_RL_iso_def nt_field_simps
by (simp_all add: nat_omega_simps)
subsubsectionβΉNatural transformation mapβΊ
lemma cf_adj_LR_iso_vsv[adj_cs_intros]:
"vsv (cf_adj_LR_iso β π π π Ξ¦ π' Ξ¨β¦NTMapβ¦)"
unfolding cf_adj_LR_iso_components by simp
lemma cf_adj_RL_iso_vsv[adj_cs_intros]:
"vsv (cf_adj_RL_iso β π π π Ξ¦ π' Ξ¨β¦NTMapβ¦)"
unfolding cf_adj_RL_iso_components by simp
lemma cf_adj_LR_iso_vdomain[adj_cs_simps]:
"πβ©β (cf_adj_LR_iso β π π π Ξ¦ π' Ξ¨β¦NTMapβ¦) = ββ¦Objβ¦"
unfolding cf_adj_LR_iso_components by simp
lemma cf_adj_RL_iso_vdomain[adj_cs_simps]:
"πβ©β (cf_adj_RL_iso β π π π Ξ¦ π' Ξ¨β¦NTMapβ¦) = πβ¦Objβ¦"
unfolding cf_adj_RL_iso_components by simp
lemma cf_adj_LR_iso_app:
fixes β π π π Ξ¦ π' Ξ¨
assumes "x ββ©β ββ¦Objβ¦"
defines "πx β‘ πβ¦ObjMapβ¦β¦xβ¦"
and "π'x β‘ π'β¦ObjMapβ¦β¦xβ¦"
and "Ξ· β‘ Ξ·β©C Ξ¦"
and "Ξ·' β‘ Ξ·β©C Ξ¨"
shows "cf_adj_LR_iso β π π π Ξ¦ π' Ξ¨β¦NTMapβ¦β¦xβ¦ =
(
THE f'.
f' : πx β¦βπβ π'x β§
Ξ·'β¦NTMapβ¦β¦xβ¦ = umap_of π x πx (Ξ·β¦NTMapβ¦β¦xβ¦) π'xβ¦ArrValβ¦β¦f'β¦
)"
using assms(1) unfolding cf_adj_LR_iso_components assms(2-5) by simp meson
lemma cf_adj_RL_iso_app:
fixes β π π π Ξ¦ π' Ξ¨
assumes "x ββ©β πβ¦Objβ¦"
defines "πx β‘ πβ¦ObjMapβ¦β¦xβ¦"
and "π'x β‘ π'β¦ObjMapβ¦β¦xβ¦"
and "Ξ΅ β‘ Ξ΅β©C Ξ¦"
and "Ξ΅' β‘ Ξ΅β©C Ξ¨"
shows "cf_adj_RL_iso β π π π Ξ¦ π' Ξ¨β¦NTMapβ¦β¦xβ¦ =
(
THE f'.
f' : π'x β¦βββ πx β§
Ξ΅'β¦NTMapβ¦β¦xβ¦ = umap_fo π x πx (Ξ΅β¦NTMapβ¦β¦xβ¦) π'xβ¦ArrValβ¦β¦f'β¦
)"
using assms(1) unfolding cf_adj_RL_iso_components assms(2-5) Let_def by simp
lemma cf_adj_LR_iso_app_unique:
fixes β π π π Ξ¦ π' Ξ¨
assumes "Ξ¦ : π ββ©Cβ©F π : β βββ©CβΞ±β π"
and "Ξ¨ : π' ββ©Cβ©F π : β βββ©CβΞ±β π"
and "x ββ©β ββ¦Objβ¦"
defines "πx β‘ πβ¦ObjMapβ¦β¦xβ¦"
and "π'x β‘ π'β¦ObjMapβ¦β¦xβ¦"
and "Ξ· β‘ Ξ·β©C Ξ¦"
and "Ξ·' β‘ Ξ·β©C Ξ¨"
and "f β‘ cf_adj_LR_iso β π π π Ξ¦ π' Ξ¨β¦NTMapβ¦β¦xβ¦"
shows
"β!f'.
f' : πx β¦βπβ π'x β§
Ξ·'β¦NTMapβ¦β¦xβ¦ = umap_of π x πx (Ξ·β¦NTMapβ¦β¦xβ¦) π'xβ¦ArrValβ¦β¦f'β¦"
"f : πx β¦β©iβ©sβ©oβπβ π'x"
"Ξ·'β¦NTMapβ¦β¦xβ¦ = umap_of π x πx (Ξ·β¦NTMapβ¦β¦xβ¦) π'xβ¦ArrValβ¦β¦fβ¦"
proof-
interpret Ξ¦: is_cf_adjunction Ξ± β π π π Ξ¦ by (rule assms(1))
interpret Ξ¨: is_cf_adjunction Ξ± β π π' π Ξ¨ by (rule assms(2))
note πa_Ξ· =
is_cf_adjunction.cf_adjunction_unit_component_is_ua_of[
OF assms(1) assms(3), folded assms(4-8)
]
note π'a_Ξ· =
is_cf_adjunction.cf_adjunction_unit_component_is_ua_of[
OF assms(2) assms(3), folded assms(4-8)
]
from
is_functor.cf_universal_arrow_of_unique[
OF Ξ¦.RL.is_functor_axioms πa_Ξ· π'a_Ξ·, folded assms(4-8)
]
obtain f'
where f': "f' : πx β¦βπβ π'x"
and Ξ·'_def:
"Ξ·'β¦NTMapβ¦β¦xβ¦ = umap_of π x πx (Ξ·β¦NTMapβ¦β¦xβ¦) π'xβ¦ArrValβ¦β¦f'β¦"
and unique_f':
"β¦
f'' : πx β¦βπβ π'x;
Ξ·'β¦NTMapβ¦β¦xβ¦ = umap_of π x πx (Ξ·β¦NTMapβ¦β¦xβ¦) π'xβ¦ArrValβ¦β¦f''β¦
β§ βΉ f'' = f'"
for f''
by metis
show unique_f': "β!f'.
f' : πx β¦βπβ π'x β§
Ξ·'β¦NTMapβ¦β¦xβ¦ = umap_of π x πx (Ξ·β¦NTMapβ¦β¦xβ¦) π'xβ¦ArrValβ¦β¦f'β¦"
by
(
rule is_functor.cf_universal_arrow_of_unique[
OF Ξ¦.RL.is_functor_axioms πa_Ξ· π'a_Ξ·, folded assms(4-8)
]
)
from
theD
[
OF unique_f' cf_adj_LR_iso_app[
OF assms(3), of π π π Ξ¦ π' Ξ¨, folded assms(4-8)
]
]
have f: "f : πx β¦βπβ π'x"
and Ξ·': "Ξ·'β¦NTMapβ¦β¦xβ¦ = umap_of π x πx (Ξ·β¦NTMapβ¦β¦xβ¦) π'xβ¦ArrValβ¦β¦fβ¦"
by simp_all
show "Ξ·'β¦NTMapβ¦β¦xβ¦ = umap_of π x πx (Ξ·β¦NTMapβ¦β¦xβ¦) π'xβ¦ArrValβ¦β¦fβ¦" by (rule Ξ·')
show "f : πx β¦β©iβ©sβ©oβπβ π'x"
by
(
rule
is_functor.cf_universal_arrow_of_is_arr_isomorphism[
OF Ξ¦.RL.is_functor_axioms πa_Ξ· π'a_Ξ· f Ξ·'
]
)
qed
subsubsectionβΉMain resultsβΊ
lemma cf_adj_LR_iso_is_iso_functor:
assumes "Ξ¦ : π ββ©Cβ©F π : β βββ©CβΞ±β π" and "Ξ¨ : π' ββ©Cβ©F π : β βββ©CβΞ±β π"
shows "β!ΞΈ.
ΞΈ : π β¦β©Cβ©F π' : β β¦β¦β©CβΞ±β π β§
Ξ·β©C Ξ¨ = (π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ΞΈ) ββ©Nβ©Tβ©Cβ©F Ξ·β©C Ξ¦"
and "cf_adj_LR_iso β π π π Ξ¦ π' Ξ¨ : π β¦β©Cβ©Fβ©.β©iβ©sβ©o π' : β β¦β¦β©CβΞ±β π"
and "Ξ·β©C Ξ¨ =
(π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F cf_adj_LR_iso β π π π Ξ¦ π' Ξ¨) ββ©Nβ©Tβ©Cβ©F Ξ·β©C Ξ¦"
proof-
interpret Ξ¦: is_cf_adjunction Ξ± β π π π Ξ¦ by (rule assms(1))
interpret Ξ¨: is_cf_adjunction Ξ± β π π' π Ξ¨ by (rule assms(2))
let ?Ξ· = βΉΞ·β©C Ξ¦βΊ
let ?Ξ·' = βΉΞ·β©C Ξ¨βΊ
let ?ΦΨ = βΉcf_adj_LR_iso β π π π Ξ¦ π' Ξ¨βΊ
show π'Ξ¨: "?ΦΨ : π β¦β©Cβ©Fβ©.β©iβ©sβ©o π' : β β¦β¦β©CβΞ±β π"
proof(intro is_iso_ntcfI is_ntcfI')
show "vfsequence ?ΦΨ" unfolding cf_adj_LR_iso_def by auto
show "vcard ?ΦΨ = 5β©β"
unfolding cf_adj_LR_iso_def by (simp add: nat_omega_simps)
show "?ΦΨβ¦NTMapβ¦β¦aβ¦ : πβ¦ObjMapβ¦β¦aβ¦ β¦βπβ π'β¦ObjMapβ¦β¦aβ¦"
if "a ββ©β ββ¦Objβ¦" for a
using cf_adj_LR_iso_app_unique(2)[OF assms that] by auto
show "?ΦΨβ¦NTMapβ¦β¦bβ¦ ββ©Aβπβ πβ¦ArrMapβ¦β¦fβ¦ = π'β¦ArrMapβ¦β¦fβ¦ ββ©Aβπβ ?ΦΨβ¦NTMapβ¦β¦aβ¦"
if "f : a β¦βββ b" for a b f
proof-
from that have a: "a ββ©β ββ¦Objβ¦" and b: "b ββ©β ββ¦Objβ¦" by auto
note unique_a = cf_adj_LR_iso_app_unique[OF assms a]
note unique_b = cf_adj_LR_iso_app_unique[OF assms b]
from unique_a(2) have a_is_arr:
"?ΦΨβ¦NTMapβ¦β¦aβ¦ : πβ¦ObjMapβ¦β¦aβ¦ β¦βπβ π'β¦ObjMapβ¦β¦aβ¦"
by auto
from unique_b(2) have b_is_arr:
"?ΦΨβ¦NTMapβ¦β¦bβ¦ : πβ¦ObjMapβ¦β¦bβ¦ β¦βπβ π'β¦ObjMapβ¦β¦bβ¦"
by auto
interpret Ξ·: is_ntcf Ξ± β β βΉcf_id ββΊ βΉπ ββ©Cβ©F πβΊ ?Ξ·
by (rule Ξ¦.cf_adjunction_unit_is_ntcf)
interpret Ξ·': is_ntcf Ξ± β β βΉcf_id ββΊ βΉπ ββ©Cβ©F π'βΊ ?Ξ·'
by (rule Ξ¨.cf_adjunction_unit_is_ntcf)
from unique_a(3) a_is_arr a b have Ξ·'_a_def:
"?Ξ·'β¦NTMapβ¦β¦aβ¦ = πβ¦ArrMapβ¦β¦?ΦΨβ¦NTMapβ¦β¦aβ¦β¦ ββ©Aβββ ?Ξ·β¦NTMapβ¦β¦aβ¦"
by (cs_prems cs_simp: cat_cs_simps cs_intro: adj_cs_intros cat_cs_intros)
from unique_b(3) b_is_arr a b have Ξ·'_b_def:
"?Ξ·'β¦NTMapβ¦β¦bβ¦ = πβ¦ArrMapβ¦β¦?ΦΨβ¦NTMapβ¦β¦bβ¦β¦ ββ©Aβββ ?Ξ·β¦NTMapβ¦β¦bβ¦"
by (cs_prems cs_simp: cat_cs_simps cs_intro: adj_cs_intros cat_cs_intros)
from that a b a_is_arr have
"πβ¦ArrMapβ¦β¦π'β¦ArrMapβ¦β¦fβ¦β¦ ββ©Aβββ
(πβ¦ArrMapβ¦β¦?ΦΨβ¦NTMapβ¦β¦aβ¦β¦ ββ©Aβββ ?Ξ·β¦NTMapβ¦β¦aβ¦) =
πβ¦ArrMapβ¦β¦π'β¦ArrMapβ¦β¦fβ¦β¦ ββ©Aβββ ?Ξ·'β¦NTMapβ¦β¦aβ¦"
by (cs_concl cs_simp: cat_cs_simps Ξ·'_a_def cs_intro: cat_cs_intros)
also from Ξ·'.ntcf_Comp_commute[OF that, symmetric] that a b have
"β¦ = ?Ξ·'β¦NTMapβ¦β¦bβ¦ ββ©Aβββ f"
by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
also from that a b b_is_arr have
"β¦ = πβ¦ArrMapβ¦β¦?ΦΨβ¦NTMapβ¦β¦bβ¦β¦ ββ©Aβββ
(?Ξ·β¦NTMapβ¦β¦bβ¦ ββ©Aβββ f)"
by (cs_concl cs_simp: cat_cs_simps Ξ·'_b_def cs_intro: cat_cs_intros)
also from that have
"β¦ = πβ¦ArrMapβ¦β¦?ΦΨβ¦NTMapβ¦β¦bβ¦β¦ ββ©Aβββ
((π ββ©Cβ©F π)β¦ArrMapβ¦β¦fβ¦ ββ©Aβββ ?Ξ·β¦NTMapβ¦β¦aβ¦)"
unfolding Ξ·.ntcf_Comp_commute[OF that, symmetric]
by (cs_concl cs_simp: cat_cs_simps Ξ·'_b_def cs_intro: cat_cs_intros)
also from that b_is_arr have
"β¦ = πβ¦ArrMapβ¦β¦?ΦΨβ¦NTMapβ¦β¦bβ¦β¦ ββ©Aβββ
(πβ¦ArrMapβ¦β¦πβ¦ArrMapβ¦β¦fβ¦β¦ ββ©Aβββ ?Ξ·β¦NTMapβ¦β¦aβ¦)"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
finally have [cat_cs_simps]:
"πβ¦ArrMapβ¦β¦π'β¦ArrMapβ¦β¦fβ¦β¦ ββ©Aβββ (πβ¦ArrMapβ¦β¦?ΦΨβ¦NTMapβ¦β¦aβ¦β¦ ββ©Aβββ
?Ξ·β¦NTMapβ¦β¦aβ¦) =
πβ¦ArrMapβ¦β¦?ΦΨβ¦NTMapβ¦β¦bβ¦β¦ ββ©Aβββ
(πβ¦ArrMapβ¦β¦πβ¦ArrMapβ¦β¦fβ¦β¦ ββ©Aβββ ?Ξ·β¦NTMapβ¦β¦aβ¦)"
by simp
note unique_f_a = is_functor.universal_arrow_ofD
[
OF
Ξ¦.RL.is_functor_axioms
Ξ¦.cf_adjunction_unit_component_is_ua_of[OF a]
]
from that a b a_is_arr b_is_arr have ππf_Ξ·a:
"πβ¦ArrMapβ¦β¦π'β¦ArrMapβ¦β¦fβ¦β¦ ββ©Aβββ ?Ξ·'β¦NTMapβ¦β¦aβ¦ :
a β¦βββ πβ¦ObjMapβ¦β¦π'β¦ObjMapβ¦β¦bβ¦β¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from b have π'b: "π'β¦ObjMapβ¦β¦bβ¦ ββ©β πβ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from unique_f_a(3)[OF π'b ππf_Ξ·a] obtain f'
where f': "f' : πβ¦ObjMapβ¦β¦aβ¦ β¦βπβ π'β¦ObjMapβ¦β¦bβ¦"
and Ξ·a: "πβ¦ArrMapβ¦β¦π'β¦ArrMapβ¦β¦fβ¦β¦ ββ©Aβββ ?Ξ·'β¦NTMapβ¦β¦aβ¦ =
umap_of π a (πβ¦ObjMapβ¦β¦aβ¦) (?Ξ·β¦NTMapβ¦β¦aβ¦) (π'β¦ObjMapβ¦β¦bβ¦)β¦ArrValβ¦β¦f'β¦"
and unique_f':
"β¦
f'' : πβ¦ObjMapβ¦β¦aβ¦ β¦βπβ π'β¦ObjMapβ¦β¦bβ¦;
πβ¦ArrMapβ¦β¦π'β¦ArrMapβ¦β¦fβ¦β¦ ββ©Aβββ ?Ξ·'β¦NTMapβ¦β¦aβ¦ =
umap_of π a (πβ¦ObjMapβ¦β¦aβ¦) (?Ξ·β¦NTMapβ¦β¦aβ¦) (π'β¦ObjMapβ¦β¦bβ¦)β¦ArrValβ¦β¦f''β¦
β§ βΉ f'' = f'"
for f''
by metis
have "?ΦΨβ¦NTMapβ¦β¦bβ¦ ββ©Aβπβ πβ¦ArrMapβ¦β¦fβ¦ = f'"
by (rule unique_f', insert a b a_is_arr b_is_arr that)
(cs_concl cs_simp: Ξ·'_a_def cat_cs_simps cs_intro: cat_cs_intros)
moreover have "π'β¦ArrMapβ¦β¦fβ¦ ββ©Aβπβ ?ΦΨβ¦NTMapβ¦β¦aβ¦ = f'"
by (rule unique_f', insert a b a_is_arr b_is_arr that)
(cs_concl cs_simp: Ξ·'_a_def cat_cs_simps cs_intro: cat_cs_intros)
ultimately show ?thesis by simp
qed
qed
(
auto
intro: cat_cs_intros adj_cs_intros
simp: adj_cs_simps cf_adj_LR_iso_app_unique(2)[OF assms]
)
interpret π'Ξ¨: is_iso_ntcf Ξ± β π π π' βΉ?ΦΨ⺠by (rule π'Ξ¨)
show Ξ·'_def: "?Ξ·' = π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ?ΦΨ ββ©Nβ©Tβ©Cβ©F Ξ·β©C Ξ¦"
proof(rule ntcf_eqI)
have dom_lhs: "πβ©β (?Ξ·'β¦NTMapβ¦) = ββ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: adj_cs_intros)
have dom_rhs: "πβ©β ((π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ?ΦΨ ββ©Nβ©Tβ©Cβ©F Ξ·β©C Ξ¦)β¦NTMapβ¦) = ββ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: adj_cs_intros cat_cs_intros)
show "?Ξ·'β¦NTMapβ¦ = (π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ?ΦΨ ββ©Nβ©Tβ©Cβ©F Ξ·β©C Ξ¦)β¦NTMapβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix a assume prems: "a ββ©β ββ¦Objβ¦"
note unique_a = cf_adj_LR_iso_app_unique[OF assms prems]
from unique_a(2) have a_is_arr:
"?ΦΨβ¦NTMapβ¦β¦aβ¦ : πβ¦ObjMapβ¦β¦aβ¦ β¦βπβ π'β¦ObjMapβ¦β¦aβ¦"
by auto
interpret Ξ·: is_ntcf Ξ± β β βΉcf_id ββΊ βΉπ ββ©Cβ©F πβΊ ?Ξ·
by (rule Ξ¦.cf_adjunction_unit_is_ntcf)
from unique_a(3) a_is_arr prems have Ξ·'_a_def:
"?Ξ·'β¦NTMapβ¦β¦aβ¦ = πβ¦ArrMapβ¦β¦?ΦΨβ¦NTMapβ¦β¦aβ¦β¦ ββ©Aβββ Ξ·β©C Ξ¦β¦NTMapβ¦β¦aβ¦"
by (cs_prems cs_simp: cat_cs_simps cs_intro: adj_cs_intros cat_cs_intros)
from prems a_is_arr show
"?Ξ·'β¦NTMapβ¦β¦aβ¦ = (π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ?ΦΨ ββ©Nβ©Tβ©Cβ©F ?Ξ·)β¦NTMapβ¦β¦aβ¦"
by (cs_concl cs_simp: Ξ·'_a_def cat_cs_simps cs_intro: cat_cs_intros)
qed (auto intro: cat_cs_intros adj_cs_intros)
qed (cs_concl cs_simp: cat_cs_simps cs_intro: adj_cs_intros cat_cs_intros)+
show "β!ΞΈ. ΞΈ : π β¦β©Cβ©F π' : β β¦β¦β©CβΞ±β π β§ ?Ξ·' = (π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ΞΈ) ββ©Nβ©Tβ©Cβ©F ?Ξ·"
proof(intro ex1I conjI; (elim conjE)?)
from π'Ξ¨ show "?ΦΨ : π β¦β©Cβ©F π' : β β¦β¦β©CβΞ±β π" by auto
show "?Ξ·' = π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ?ΦΨ ββ©Nβ©Tβ©Cβ©F Ξ·β©C Ξ¦" by (rule Ξ·'_def)
fix ΞΈ assume prems:
"ΞΈ : π β¦β©Cβ©F π' : β β¦β¦β©CβΞ±β π"
"?Ξ·' = π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ΞΈ ββ©Nβ©Tβ©Cβ©F Ξ·β©C Ξ¦"
interpret ΞΈ: is_ntcf Ξ± β π π π' ΞΈ by (rule prems(1))
from prems have Ξ·'_a:
"?Ξ·'β¦NTMapβ¦β¦aβ¦ = (π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ΞΈ ββ©Nβ©Tβ©Cβ©F Ξ·β©C Ξ¦)β¦NTMapβ¦β¦aβ¦"
for a
by simp
have Ξ·'a: "Ξ·β©C Ξ¨β¦NTMapβ¦β¦aβ¦ =
πβ¦ArrMapβ¦β¦ΞΈβ¦NTMapβ¦β¦aβ¦β¦ ββ©Aβββ Ξ·β©C Ξ¦β¦NTMapβ¦β¦aβ¦"
if "a ββ©β ββ¦Objβ¦" for a
using Ξ·'_a[where a=a] that
by (cs_prems cs_simp: cat_cs_simps cs_intro: adj_cs_intros cat_cs_intros)
show "θ = ?ΦΨ"
proof(rule ntcf_eqI)
have dom_lhs: "πβ©β (ΞΈβ¦NTMapβ¦) = ββ¦Objβ¦" by (cs_concl cs_simp: cat_cs_simps)
have dom_rhs: "πβ©β (?ΦΨβ¦NTMapβ¦) = ββ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps)
show "ΞΈβ¦NTMapβ¦ = ?ΦΨβ¦NTMapβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix a assume prems': "a ββ©β ββ¦Objβ¦"
let ?uof = βΉumap_of π a (πβ¦ObjMapβ¦β¦aβ¦) (?Ξ·β¦NTMapβ¦β¦aβ¦) (π'β¦ObjMapβ¦β¦aβ¦)βΊ
from cf_adj_LR_iso_app_unique[OF assms prems'] obtain f'
where f': "f' : πβ¦ObjMapβ¦β¦aβ¦ β¦βπβ π'β¦ObjMapβ¦β¦aβ¦"
and Ξ·_def: "?Ξ·'β¦NTMapβ¦β¦aβ¦ = ?uofβ¦ArrValβ¦β¦f'β¦"
and unique_f': "βf''.
β¦
f'' : πβ¦ObjMapβ¦β¦aβ¦ β¦βπβ π'β¦ObjMapβ¦β¦aβ¦;
?Ξ·'β¦NTMapβ¦β¦aβ¦ = ?uofβ¦ArrValβ¦β¦f''β¦
β§ βΉ f'' = f'"
by metis
from prems' have ΞΈa: "ΞΈβ¦NTMapβ¦β¦aβ¦ : πβ¦ObjMapβ¦β¦aβ¦ β¦βπβ π'β¦ObjMapβ¦β¦aβ¦"
by (cs_concl cs_simp: cs_intro: cat_cs_intros)
from Ξ·_def f' prems' have
"Ξ·β©C Ξ¨β¦NTMapβ¦β¦aβ¦ = πβ¦ArrMapβ¦β¦f'β¦ ββ©Aβββ Ξ·β©C Ξ¦β¦NTMapβ¦β¦aβ¦"
by
(
cs_prems
cs_simp: cat_cs_simps cs_intro: adj_cs_intros cat_cs_intros
)
from prems' have "Ξ·β©C Ξ¨β¦NTMapβ¦β¦aβ¦ = ?uofβ¦ArrValβ¦β¦ΞΈβ¦NTMapβ¦β¦aβ¦β¦"
by
(
cs_concl
cs_simp: cat_cs_simps Ξ·'a[OF prems']
cs_intro: adj_cs_intros cat_cs_intros
)
from unique_f'[OF ΞΈa this] have ΞΈa: "ΞΈβ¦NTMapβ¦β¦aβ¦ = f'".
from prems' have Ξ¨a:
"?ΦΨβ¦NTMapβ¦β¦aβ¦ : πβ¦ObjMapβ¦β¦aβ¦ β¦βπβ π'β¦ObjMapβ¦β¦aβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from prems' have "Ξ·β©C Ξ¨β¦NTMapβ¦β¦aβ¦ = ?uofβ¦ArrValβ¦β¦?ΦΨβ¦NTMapβ¦β¦aβ¦β¦"
by
(
cs_concl
cs_simp: cf_adj_LR_iso_app_unique(3)[OF assms] cat_cs_simps
cs_intro: adj_cs_intros cat_cs_intros
)
from unique_f'[OF Ξ¨a this] have π'Ξ¨_def: "?ΦΨβ¦NTMapβ¦β¦aβ¦ = f'".
show "ΞΈβ¦NTMapβ¦β¦aβ¦ = ?ΦΨβ¦NTMapβ¦β¦aβ¦" unfolding ΞΈa π'Ξ¨_def ..
qed auto
qed (cs_concl cs_simp: cs_intro: cat_cs_intros)+
qed
qed
lemma op_ntcf_cf_adj_RL_iso[cat_op_simps]:
assumes "Ξ¦ : π ββ©Cβ©F π : β βββ©CβΞ±β π"
and "Ξ¨ : π ββ©Cβ©F π' : β βββ©CβΞ±β π"
defines "op_π β‘ op_cat π"
and "op_β β‘ op_cat β"
and "op_π β‘ op_cf π"
and "op_π β‘ op_cf π"
and "op_Ξ¦ β‘ op_cf_adj Ξ¦"
and "op_π' β‘ op_cf π'"
and "op_Ξ¨ β‘ op_cf_adj Ξ¨"
shows
"op_ntcf (cf_adj_RL_iso β π π π Ξ¦ π' Ξ¨) =
cf_adj_LR_iso op_π op_β op_π op_π op_Ξ¦ op_π' op_Ξ¨"
proof-
interpret Ξ¦: is_cf_adjunction Ξ± β π π π Ξ¦ by (rule assms(1))
interpret Ξ¨: is_cf_adjunction Ξ± β π π π' Ξ¨ by (rule assms(2))
interpret Ξ΅: is_ntcf Ξ± π π βΉπ ββ©Cβ©F πβΊ βΉcf_id πβΊ βΉΞ΅β©C Ξ¦βΊ
by (rule Ξ¦.cf_adjunction_counit_is_ntcf)
have dom_lhs: "πβ©β (op_ntcf (cf_adj_RL_iso β π π π Ξ¦ π' Ξ¨)) = 5β©β"
unfolding op_ntcf_def by (simp add: nat_omega_simps)
show ?thesis
proof(rule vsv_eqI, unfold dom_lhs)
fix a assume prems: "a ββ©β 5β©β"
then have "a ββ©β 5β©β" unfolding dom_lhs by simp
then show
"op_ntcf (cf_adj_RL_iso β π π π Ξ¦ π' Ξ¨)β¦aβ¦ =
cf_adj_LR_iso op_π op_β op_π op_π op_Ξ¦ op_π' op_Ξ¨β¦aβ¦"
by
(
elim_in_numeral,
fold nt_field_simps,
unfold
cf_adj_LR_iso_components
op_ntcf_components
cf_adj_RL_iso_components
Let_def
Ξ¦.cf_adjunction_unit_NTMap_op
Ξ¨.cf_adjunction_unit_NTMap_op
assms(3-9)
cat_op_simps
)
simp_all
qed (auto simp: op_ntcf_def cf_adj_LR_iso_def nat_omega_simps)
qed
lemma op_ntcf_cf_adj_LR_iso[cat_op_simps]:
assumes "Ξ¦ : π ββ©Cβ©F π : β βββ©CβΞ±β π" and "Ξ¨ : π' ββ©Cβ©F π : β βββ©CβΞ±β π"
defines "op_π β‘ op_cat π"
and "op_β β‘ op_cat β"
and "op_π β‘ op_cf π"
and "op_π β‘ op_cf π"
and "op_Ξ¦ β‘ op_cf_adj Ξ¦"
and "op_π' β‘ op_cf π'"
and "op_Ξ¨ β‘ op_cf_adj Ξ¨"
shows
"op_ntcf (cf_adj_LR_iso β π π π Ξ¦ π' Ξ¨) =
cf_adj_RL_iso op_π op_β op_π op_π op_Ξ¦ op_π' op_Ξ¨"
proof-
interpret Ξ¦: is_cf_adjunction Ξ± β π π π Ξ¦ by (rule assms(1))
interpret Ξ¨: is_cf_adjunction Ξ± β π π' π Ξ¨ by (rule assms(2))
interpret Ξ΅: is_ntcf Ξ± π π βΉπ ββ©Cβ©F πβΊ βΉcf_id πβΊ βΉΞ΅β©C Ξ¦βΊ
by (rule Ξ¦.cf_adjunction_counit_is_ntcf)
have dom_lhs: "πβ©β (op_ntcf (cf_adj_LR_iso β π π π Ξ¦ π' Ξ¨)) = 5β©β"
unfolding op_ntcf_def by (simp add: nat_omega_simps)
show ?thesis
proof(rule vsv_eqI, unfold dom_lhs)
fix a assume prems: "a ββ©β 5β©β"
then show
"op_ntcf (cf_adj_LR_iso β π π π Ξ¦ π' Ξ¨)β¦aβ¦ =
cf_adj_RL_iso op_π op_β op_π op_π op_Ξ¦ op_π' op_Ξ¨β¦aβ¦"
by
(
elim_in_numeral,
use nothing in
βΉ
fold nt_field_simps,
unfold
cf_adj_LR_iso_components
op_ntcf_components
cf_adj_RL_iso_components
Let_def
Ξ¦.op_ntcf_cf_adjunction_unit[symmetric]
Ξ¨.op_ntcf_cf_adjunction_unit[symmetric]
assms(3-9)
cat_op_simps
βΊ
)
simp_all
qed (auto simp: op_ntcf_def cf_adj_RL_iso_def nat_omega_simps)
qed
lemma cf_adj_RL_iso_app_unique:
fixes β π π π Ξ¦ π' Ξ¨
assumes "Ξ¦ : π ββ©Cβ©F π : β βββ©CβΞ±β π"
and "Ξ¨ : π ββ©Cβ©F π' : β βββ©CβΞ±β π"
and "x ββ©β πβ¦Objβ¦"
defines "πx β‘ πβ¦ObjMapβ¦β¦xβ¦"
and "π'x β‘ π'β¦ObjMapβ¦β¦xβ¦"
and "Ξ΅ β‘ Ξ΅β©C Ξ¦"
and "Ξ΅' β‘ Ξ΅β©C Ξ¨"
and "f β‘ cf_adj_RL_iso β π π π Ξ¦ π' Ξ¨β¦NTMapβ¦β¦xβ¦"
shows
"β!f'.
f' : π'x β¦βββ πx β§
Ξ΅'β¦NTMapβ¦β¦xβ¦ = umap_fo π x πx (Ξ΅β¦NTMapβ¦β¦xβ¦) π'xβ¦ArrValβ¦β¦f'β¦"
"f : π'x β¦β©iβ©sβ©oβββ πx"
"Ξ΅'β¦NTMapβ¦β¦xβ¦ = umap_fo π x πx (Ξ΅β¦NTMapβ¦β¦xβ¦) π'xβ¦ArrValβ¦β¦fβ¦"
proof-
interpret Ξ¦: is_cf_adjunction Ξ± β π π π Ξ¦ by (rule assms(1))
interpret Ξ¨: is_cf_adjunction Ξ± β π π π' Ξ¨ by (rule assms(2))
interpret Ξ΅: is_ntcf Ξ± π π βΉπ ββ©Cβ©F πβΊ βΉcf_id πβΊ βΉΞ΅β©C Ξ¦βΊ
by (rule Ξ¦.cf_adjunction_counit_is_ntcf)
show
"β!f'.
f' : π'x β¦βββ πx β§
Ξ΅'β¦NTMapβ¦β¦xβ¦ = umap_fo π x πx (Ξ΅β¦NTMapβ¦β¦xβ¦) π'xβ¦ArrValβ¦β¦f'β¦"
"f : π'x β¦β©iβ©sβ©oβββ πx"
"Ξ΅'β¦NTMapβ¦β¦xβ¦ = umap_fo π x πx (Ξ΅β¦NTMapβ¦β¦xβ¦) π'xβ¦ArrValβ¦β¦fβ¦"
by
(
intro cf_adj_LR_iso_app_unique
[
OF Ξ¦.is_cf_adjunction_op Ξ¨.is_cf_adjunction_op,
unfolded cat_op_simps,
OF assms(3),
unfolded Ξ¨.cf_adjunction_unit_NTMap_op,
folded Ξ¦.op_ntcf_cf_adjunction_counit,
folded op_ntcf_cf_adj_RL_iso[OF assms(1,2)],
unfolded cat_op_simps,
folded assms(4-8)
]
)+
qed
lemma cf_adj_RL_iso_is_iso_functor:
assumes "Ξ¦ : π ββ©Cβ©F π : β βββ©CβΞ±β π" and "Ξ¨ : π ββ©Cβ©F π' : β βββ©CβΞ±β π"
shows "β!ΞΈ.
ΞΈ : π' β¦β©Cβ©F π : π β¦β¦β©CβΞ±β β β§
Ξ΅β©C Ξ¨ = Ξ΅β©C Ξ¦ ββ©Nβ©Tβ©Cβ©F (π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ΞΈ)"
and "cf_adj_RL_iso β π π π Ξ¦ π' Ξ¨ : π' β¦β©Cβ©Fβ©.β©iβ©sβ©o π : π β¦β¦β©CβΞ±β β"
and "Ξ΅β©C Ξ¨ =
Ξ΅β©C Ξ¦ ββ©Nβ©Tβ©Cβ©F (π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F cf_adj_RL_iso β π π π Ξ¦ π' Ξ¨)"
proof-
interpret Ξ¦: is_cf_adjunction Ξ± β π π π Ξ¦ by (rule assms(1))
interpret Ξ¨: is_cf_adjunction Ξ± β π π π' Ξ¨ by (rule assms(2))
interpret Ξ΅: is_ntcf Ξ± π π βΉπ ββ©Cβ©F πβΊ βΉcf_id πβΊ βΉΞ΅β©C Ξ¦βΊ
by (rule Ξ¦.cf_adjunction_counit_is_ntcf)
note cf_adj_LR_iso_is_iso_functor_op = cf_adj_LR_iso_is_iso_functor
[
OF Ξ¦.is_cf_adjunction_op Ξ¨.is_cf_adjunction_op,
folded
Ξ¦.op_ntcf_cf_adjunction_counit
Ξ¨.op_ntcf_cf_adjunction_counit
op_ntcf_cf_adj_RL_iso[OF assms]
]
from cf_adj_LR_iso_is_iso_functor_op(1) obtain ΞΈ
where ΞΈ: "ΞΈ : op_cf π β¦β©Cβ©F op_cf π' : op_cat π β¦β¦β©CβΞ±β op_cat β"
and op_ntcf_Ξ΅_def: "op_ntcf (Ξ΅β©C Ξ¨) =
op_cf π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ΞΈ ββ©Nβ©Tβ©Cβ©F op_ntcf (Ξ΅β©C Ξ¦)"
and unique_ΞΈ':
"β¦
ΞΈ' : op_cf π β¦β©Cβ©F op_cf π' : op_cat π β¦β¦β©CβΞ±β op_cat β;
op_ntcf (Ξ΅β©C Ξ¨) = op_cf π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ΞΈ' ββ©Nβ©Tβ©Cβ©F op_ntcf (Ξ΅β©C Ξ¦)
β§ βΉ ΞΈ' = ΞΈ"
for ΞΈ'
by metis
interpret ΞΈ: is_ntcf Ξ± βΉop_cat πβΊ βΉop_cat ββΊ βΉop_cf πβΊ βΉop_cf π'βΊ ΞΈ
by (rule ΞΈ)
show "β!ΞΈ. ΞΈ : π' β¦β©Cβ©F π : π β¦β¦β©CβΞ±β β β§ Ξ΅β©C Ξ¨ = Ξ΅β©C Ξ¦ ββ©Nβ©Tβ©Cβ©F (π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ΞΈ)"
proof(intro ex1I conjI; (elim conjE)?)
show op_ΞΈ: "op_ntcf ΞΈ : π' β¦β©Cβ©F π : π β¦β¦β©CβΞ±β β"
by (rule ΞΈ.is_ntcf_op[unfolded cat_op_simps])
from op_ntcf_Ξ΅_def have
"op_ntcf (op_ntcf (Ξ΅β©C Ξ¨)) =
op_ntcf (op_cf π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ΞΈ ββ©Nβ©Tβ©Cβ©F op_ntcf (Ξ΅β©C Ξ¦))"
by simp
then show Ξ΅_def: "Ξ΅β©C Ξ¨ = Ξ΅β©C Ξ¦ ββ©Nβ©Tβ©Cβ©F (π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F op_ntcf ΞΈ)"
by
(
cs_prems
cs_simp: cat_op_simps
cs_intro: adj_cs_intros cat_cs_intros cat_op_intros
)
fix ΞΈ' assume prems:
"ΞΈ' : π' β¦β©Cβ©F π : π β¦β¦β©CβΞ±β β"
"Ξ΅β©C Ξ¨ = Ξ΅β©C Ξ¦ ββ©Nβ©Tβ©Cβ©F (π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ΞΈ')"
interpret ΞΈ': is_ntcf Ξ± π β π' π ΞΈ' by (rule prems(1))
have "op_ntcf (Ξ΅β©C Ξ¨) = op_cf π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F op_ntcf ΞΈ' ββ©Nβ©Tβ©Cβ©F op_ntcf (Ξ΅β©C Ξ¦)"
by
(
cs_concl
cs_simp:
prems(2)
op_ntcf_cf_ntcf_comp[symmetric]
op_ntcf_ntcf_vcomp[symmetric]
cs_intro: cat_cs_intros
)
from unique_ΞΈ'[OF ΞΈ'.is_ntcf_op this, symmetric] have
"op_ntcf ΞΈ = op_ntcf (op_ntcf ΞΈ')"
by simp
then show "ΞΈ' = op_ntcf ΞΈ"
by (cs_prems cs_simp: cat_cs_simps cat_op_simps) simp
qed
from is_iso_ntcf.is_iso_ntcf_op[OF cf_adj_LR_iso_is_iso_functor_op(2)] show
"cf_adj_RL_iso β π π π Ξ¦ π' Ξ¨ : π' β¦β©Cβ©Fβ©.β©iβ©sβ©o π : π β¦β¦β©CβΞ±β β"
by (cs_prems cs_simp: cat_op_simps cs_intro: adj_cs_intros cat_op_intros)
from cf_adj_LR_iso_is_iso_functor_op(3) have
"op_ntcf (op_ntcf (Ξ΅β©C Ξ¨)) =
op_ntcf
(
op_cf π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F op_ntcf (cf_adj_RL_iso β π π π Ξ¦ π' Ξ¨) ββ©Nβ©Tβ©Cβ©F
op_ntcf (Ξ΅β©C Ξ¦)
)"
by simp
from
this
cf_adj_LR_iso_is_iso_functor_op(2)[
unfolded op_ntcf_cf_adj_RL_iso[OF assms]
]
show "Ξ΅β©C Ξ¨ = Ξ΅β©C Ξ¦ ββ©Nβ©Tβ©Cβ©F (π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F cf_adj_RL_iso β π π π Ξ¦ π' Ξ¨)"
by
(
cs_prems
cs_simp: cat_op_simps cat_op_simps
cs_intro: ntcf_cs_intros adj_cs_intros cat_cs_intros cat_op_intros
)
qed
subsectionβΉFurther properties of the adjoint functorsβΊ
lemma (in is_cf_adjunction) cf_adj_exp_cf_cat:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²" and "category Ξ± π"
shows
"cf_adjunction_of_unit
Ξ²
(exp_cf_cat Ξ± π π)
(exp_cf_cat Ξ± π π)
(exp_ntcf_cat Ξ± (Ξ·β©C Ξ¦) π) :
exp_cf_cat Ξ± π π ββ©Cβ©F exp_cf_cat Ξ± π π :
cat_FUNCT Ξ± π β βββ©CβΞ²β cat_FUNCT Ξ± π π"
proof-
interpret Ξ²: π΅ Ξ² by (rule assms(1))
interpret π: category Ξ± π by (rule assms(3))
show ?thesis
proof
(
rule counit_unit_is_cf_adjunction(1)[
where Ξ΅ = βΉexp_ntcf_cat Ξ± (Ξ΅β©C Ξ¦) πβΊ
]
)
from assms show "exp_ntcf_cat Ξ± (Ξ·β©C Ξ¦) π :
cf_id (cat_FUNCT Ξ± π β) β¦β©Cβ©F exp_cf_cat Ξ± π π ββ©Cβ©F exp_cf_cat Ξ± π π :
cat_FUNCT Ξ± π β β¦β¦β©CβΞ²β cat_FUNCT Ξ± π β"
by
(
cs_concl
cs_simp:
cat_cs_simps cat_FUNCT_cs_simps
exp_cf_cat_cf_id_cat[symmetric] exp_cf_cat_cf_comp[symmetric]
cs_intro:
cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros adj_cs_intros
)
from assms show
"exp_ntcf_cat Ξ± (Ξ΅β©C Ξ¦) π :
exp_cf_cat Ξ± π π ββ©Cβ©F exp_cf_cat Ξ± π π β¦β©Cβ©F cf_id (cat_FUNCT Ξ± π π) :
cat_FUNCT Ξ± π π β¦β¦β©CβΞ²β cat_FUNCT Ξ± π π"
by
(
cs_concl
cs_simp:
cat_cs_simps
cat_FUNCT_cs_simps
exp_cf_cat_cf_id_cat[symmetric]
exp_cf_cat_cf_comp[symmetric]
cs_intro:
cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros adj_cs_intros
)
note [symmetric, cat_cs_simps] =
ntcf_id_exp_cf_cat
exp_ntcf_cat_ntcf_vcomp
exp_ntcf_cat_ntcf_cf_comp
exp_ntcf_cat_cf_ntcf_comp
from assms show
"(exp_cf_cat Ξ± π π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F exp_ntcf_cat Ξ± (Ξ΅β©C Ξ¦) π) ββ©Nβ©Tβ©Cβ©F
(exp_ntcf_cat Ξ± (Ξ·β©C Ξ¦) π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F exp_cf_cat Ξ± π π) =
ntcf_id (exp_cf_cat Ξ± π π)"
by
(
cs_concl
cs_simp: adj_cs_simps cat_cs_simps
cs_intro: adj_cs_intros cat_cs_intros
)
from assms show
"exp_ntcf_cat Ξ± (Ξ΅β©C Ξ¦) π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F exp_cf_cat Ξ± π π ββ©Nβ©Tβ©Cβ©F
(exp_cf_cat Ξ± π π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F exp_ntcf_cat Ξ± (Ξ·β©C Ξ¦) π) =
ntcf_id (exp_cf_cat Ξ± π π)"
by
(
cs_concl
cs_simp: adj_cs_simps cat_cs_simps
cs_intro: adj_cs_intros cat_cs_intros
)
qed
(
use assms in
βΉ
cs_concl
cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
βΊ
)+
qed
lemma (in is_cf_adjunction) cf_adj_exp_cf_cat_exp_cf_cat:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²" and "category Ξ± π"
shows
"cf_adjunction_of_unit
Ξ²
(exp_cat_cf Ξ± π π)
(exp_cat_cf Ξ± π π)
(exp_cat_ntcf Ξ± π (Ξ·β©C Ξ¦)) :
exp_cat_cf Ξ± π π ββ©Cβ©F exp_cat_cf Ξ± π π :
cat_FUNCT Ξ± β π βββ©CβΞ²β cat_FUNCT Ξ± π π"
proof-
interpret Ξ²: π΅ Ξ² by (rule assms(1))
interpret π: category Ξ± π by (rule assms(3))
show ?thesis
proof
(
rule counit_unit_is_cf_adjunction(1)[
where Ξ΅ = βΉexp_cat_ntcf Ξ± π (Ξ΅β©C Ξ¦)βΊ
]
)
from assms is_cf_adjunction_axioms show
"exp_cat_ntcf Ξ± π (Ξ·β©C Ξ¦) :
cf_id (cat_FUNCT Ξ± β π) β¦β©Cβ©F exp_cat_cf Ξ± π π ββ©Cβ©F exp_cat_cf Ξ± π π :
cat_FUNCT Ξ± β π β¦β¦β©CβΞ²β cat_FUNCT Ξ± β π"
by
(
cs_concl
cs_simp:
exp_cat_cf_cat_cf_id[symmetric] exp_cat_cf_cf_comp[symmetric]
cs_intro: cat_small_cs_intros cat_FUNCT_cs_intros adj_cs_intros
)
from assms is_cf_adjunction_axioms show
"exp_cat_ntcf Ξ± π (Ξ΅β©C Ξ¦) :
exp_cat_cf Ξ± π π ββ©Cβ©F exp_cat_cf Ξ± π π β¦β©Cβ©F cf_id (cat_FUNCT Ξ± π π) :
cat_FUNCT Ξ± π π β¦β¦β©CβΞ²β cat_FUNCT Ξ± π π"
by
(
cs_concl
cs_simp:
exp_cat_cf_cat_cf_id[symmetric] exp_cat_cf_cf_comp[symmetric]
cs_intro: cat_small_cs_intros cat_FUNCT_cs_intros adj_cs_intros
)
note [symmetric, cat_cs_simps] =
ntcf_id_exp_cat_cf
exp_cat_ntcf_ntcf_vcomp
exp_cat_ntcf_ntcf_cf_comp
exp_cat_ntcf_cf_ntcf_comp
from assms show
"exp_cat_cf Ξ± π π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F exp_cat_ntcf Ξ± π (Ξ΅β©C Ξ¦) ββ©Nβ©Tβ©Cβ©F
(exp_cat_ntcf Ξ± π (Ξ·β©C Ξ¦) ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F exp_cat_cf Ξ± π π) =
ntcf_id (exp_cat_cf Ξ± π π)"
by
(
cs_concl
cs_simp: adj_cs_simps cat_cs_simps
cs_intro: adj_cs_intros cat_cs_intros
)
from assms show
"exp_cat_ntcf Ξ± π (Ξ΅β©C Ξ¦) ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F exp_cat_cf Ξ± π π ββ©Nβ©Tβ©Cβ©F
(exp_cat_cf Ξ± π π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F exp_cat_ntcf Ξ± π (Ξ·β©C Ξ¦)) =
ntcf_id (exp_cat_cf Ξ± π π)"
by
(
cs_concl
cs_simp: adj_cs_simps cat_cs_simps
cs_intro: adj_cs_intros cat_cs_intros
)
qed
(
use assms in
βΉ
cs_concl
cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
βΊ
)+
qed
textβΉ\newpageβΊ
endTheory CZH_UCAT_Kan
sectionβΉSimple Kan extensionsβΊ
theory CZH_UCAT_Kan
imports
CZH_Elementary_Categories.CZH_ECAT_Comma
CZH_UCAT_Limit
CZH_UCAT_Adjoints
begin
subsectionβΉBackgroundβΊ
named_theorems ua_field_simps
definition UObj :: V where [ua_field_simps]: "UObj = 0"
definition UArr :: V where [ua_field_simps]: "UArr = 1β©β"
named_theorems cat_Kan_cs_simps
named_theorems cat_Kan_cs_intros
subsectionβΉKan extensionβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉSee Chapter X-3 in \cite{mac_lane_categories_2010}.βΊ
locale is_cat_rKe =
AG: is_functor Ξ± π
β π +
Ran: is_functor Ξ± β π π +
ntcf_rKe: is_ntcf Ξ± π
π βΉπ ββ©Cβ©F πβΊ π Ξ΅
for Ξ± π
β π π π π Ξ΅ +
assumes cat_rKe_ua_fo:
"universal_arrow_fo
(exp_cat_cf Ξ± π π)
(cf_map π)
(cf_map π)
(ntcf_arrow Ξ΅)"
syntax "_is_cat_rKe" :: "V β V β V β V β V β V β V β V β bool"
(βΉ(_ :/ _ ββ©Cβ©F _ β¦β©Cβ©Fβ©.β©rβ©Kβ©eΔ± _ :/ _ β¦β©C _ β¦β©C _)βΊ [51, 51, 51, 51, 51, 51, 51] 51)
translations "Ξ΅ : π ββ©Cβ©F π β¦β©Cβ©Fβ©.β©rβ©Kβ©eβΞ±β π : π
β¦β©C β β¦β©C π" β
"CONST is_cat_rKe Ξ± π
β π π π π Ξ΅"
locale is_cat_lKe =
AG: is_functor Ξ± π
β π +
Lan: is_functor Ξ± β π π +
ntcf_lKe: is_ntcf Ξ± π
π π βΉπ ββ©Cβ©F πβΊ Ξ·
for Ξ± π
β π π π π Ξ· +
assumes cat_lKe_ua_fo:
"universal_arrow_fo
(exp_cat_cf Ξ± (op_cat π) (op_cf π))
(cf_map π)
(cf_map π)
(ntcf_arrow (op_ntcf Ξ·))"
syntax "_is_cat_lKe" :: "V β V β V β V β V β V β V β V β bool"
(βΉ(_ :/ _ β¦β©Cβ©Fβ©.β©lβ©Kβ©eΔ± _ ββ©Cβ©F _ :/ _ β¦β©C _ β¦β©C _)βΊ [51, 51, 51, 51, 51, 51, 51] 51)
translations "Ξ· : π β¦β©Cβ©Fβ©.β©lβ©Kβ©eβΞ±β π ββ©Cβ©F π : π
β¦β©C β β¦β©C π" β
"CONST is_cat_lKe Ξ± π
β π π π π Ξ·"
textβΉRules.βΊ
lemma (in is_cat_rKe) is_cat_rKe_axioms'[cat_Kan_cs_intros]:
assumes "Ξ±' = Ξ±"
and "π' = π"
and "π' = π"
and "π' = π"
and "π
' = π
"
and "π' = π"
and "β' = β"
shows "Ξ΅ : π' ββ©Cβ©F π' β¦β©Cβ©Fβ©.β©rβ©Kβ©eβΞ±'β π' : π
' β¦β©C β' β¦β©C π'"
unfolding assms by (rule is_cat_rKe_axioms)
mk_ide rf is_cat_rKe_def[unfolded is_cat_rKe_axioms_def]
|intro is_cat_rKeI|
|dest is_cat_rKeD[dest]|
|elim is_cat_rKeE[elim]|
lemmas [cat_Kan_cs_intros] = is_cat_rKeD(1-3)
lemma (in is_cat_lKe) is_cat_lKe_axioms'[cat_Kan_cs_intros]:
assumes "Ξ±' = Ξ±"
and "π' = π"
and "π' = π"
and "π' = π"
and "π
' = π
"
and "π' = π"
and "β' = β"
shows "Ξ· : π' β¦β©Cβ©Fβ©.β©lβ©Kβ©eβΞ±β π' ββ©Cβ©F π' : π
' β¦β©C β' β¦β©C π'"
unfolding assms by (rule is_cat_lKe_axioms)
mk_ide rf is_cat_lKe_def[unfolded is_cat_lKe_axioms_def]
|intro is_cat_lKeI|
|dest is_cat_lKeD[dest]|
|elim is_cat_lKeE[elim]|
lemmas [cat_Kan_cs_intros] = is_cat_lKeD(1-3)
textβΉDuality.βΊ
lemma (in is_cat_rKe) is_cat_lKe_op:
"op_ntcf Ξ΅ :
op_cf π β¦β©Cβ©Fβ©.β©lβ©Kβ©eβΞ±β op_cf π ββ©Cβ©F op_cf π :
op_cat π
β¦β©C op_cat β β¦β©C op_cat π"
by (intro is_cat_lKeI, unfold cat_op_simps; (intro cat_rKe_ua_fo)?)
(cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)+
lemma (in is_cat_rKe) is_cat_lKe_op'[cat_op_intros]:
assumes "π' = op_cf π"
and "π' = op_cf π"
and "π' = op_cf π"
and "π
' = op_cat π
"
and "π' = op_cat π"
and "β' = op_cat β"
shows "op_ntcf Ξ΅ : π' β¦β©Cβ©Fβ©.β©lβ©Kβ©eβΞ±β π' ββ©Cβ©F π' : π
' β¦β©C β' β¦β©C π'"
unfolding assms by (rule is_cat_lKe_op)
lemmas [cat_op_intros] = is_cat_rKe.is_cat_lKe_op'
lemma (in is_cat_lKe) is_cat_rKe_op:
"op_ntcf Ξ· :
op_cf π ββ©Cβ©F op_cf π β¦β©Cβ©Fβ©.β©rβ©Kβ©eβΞ±β op_cf π :
op_cat π
β¦β©C op_cat β β¦β©C op_cat π"
by (intro is_cat_rKeI, unfold cat_op_simps; (intro cat_lKe_ua_fo)?)
(cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)+
lemma (in is_cat_lKe) is_cat_lKe_op'[cat_op_intros]:
assumes "π' = op_cf π"
and "π' = op_cf π"
and "π' = op_cf π"
and "π
' = op_cat π
"
and "π' = op_cat π"
and "β' = op_cat β"
shows "op_ntcf Ξ· : π' ββ©Cβ©F π' β¦β©Cβ©Fβ©.β©rβ©Kβ©eβΞ±β π' : π
' β¦β©C β' β¦β©C π'"
unfolding assms by (rule is_cat_rKe_op)
lemmas [cat_op_intros] = is_cat_lKe.is_cat_lKe_op'
textβΉElementary properties.βΊ
lemma (in is_cat_rKe) cat_rKe_exp_cat_cf_cat_FUNCT_is_arr:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²"
shows "exp_cat_cf Ξ± π π : cat_FUNCT Ξ± β π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ²β cat_FUNCT Ξ± π
π"
by
(
rule exp_cat_cf_is_tiny_functor[
OF assms Ran.HomCod.category_axioms AG.is_functor_axioms
]
)
lemma (in is_cat_lKe) cat_lKe_exp_cat_cf_cat_FUNCT_is_arr:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²"
shows "exp_cat_cf Ξ± π π : cat_FUNCT Ξ± β π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ²β cat_FUNCT Ξ± π
π"
by
(
rule exp_cat_cf_is_tiny_functor[
OF assms Lan.HomCod.category_axioms AG.is_functor_axioms
]
)
subsubsectionβΉUniversal propertyβΊ
textβΉ
See Chapter X-3 in \cite{mac_lane_categories_2010} and
\cite{noauthor_wikipedia_2001}\footnote{
\url{https://en.wikipedia.org/wiki/Kan_extension}
}.
βΊ
lemma is_cat_rKeI':
assumes "π : π
β¦β¦β©CβΞ±β β"
and "π : β β¦β¦β©CβΞ±β π"
and "Ξ΅ : π ββ©Cβ©F π β¦β©Cβ©F π : π
β¦β¦β©CβΞ±β π"
and "βπ' Ξ΅'.
β¦ π' : β β¦β¦β©CβΞ±β π; Ξ΅' : π' ββ©Cβ©F π β¦β©Cβ©F π : π
β¦β¦β©CβΞ±β π β§ βΉ
β!Ο. Ο : π' β¦β©Cβ©F π : β β¦β¦β©CβΞ±β π β§ Ξ΅' = Ξ΅ ββ©Nβ©Tβ©Cβ©F (Ο ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π)"
shows "Ξ΅ : π ββ©Cβ©F π β¦β©Cβ©Fβ©.β©rβ©Kβ©eβΞ±β π : π
β¦β©C β β¦β©C π"
proof-
interpret π: is_functor Ξ± π
β π by (rule assms(1))
interpret π: is_functor Ξ± β π π by (rule assms(2))
interpret Ξ΅: is_ntcf Ξ± π
π βΉπ ββ©Cβ©F πβΊ π Ξ΅ by (rule assms(3))
let ?ππ = βΉexp_cat_cf Ξ± π πβΊ
and ?π = βΉcf_map πβΊ
and ?π = βΉcf_map πβΊ
show ?thesis
proof(intro is_cat_rKeI is_functor.universal_arrow_foI assms)
define Ξ² where "Ξ² = Ξ± + Ο"
have "π΅ Ξ²" and Ξ±Ξ²: "Ξ± ββ©β Ξ²"
by (simp_all add: Ξ²_def π.π΅_Limit_Ξ±Ο π.π΅_Ο_Ξ±Ο π΅_def π.π΅_Ξ±_Ξ±Ο)
then interpret Ξ²: π΅ Ξ² by simp
show "?ππ : cat_FUNCT Ξ± β π β¦β¦β©CβΞ²β cat_FUNCT Ξ± π
π"
by
(
cs_concl cs_intro:
cat_small_cs_intros
exp_cat_cf_is_tiny_functor[
OF Ξ².π΅_axioms Ξ±Ξ² π.HomCod.category_axioms assms(1)
]
)
from Ξ±Ξ² assms(2) show "cf_map π ββ©β cat_FUNCT Ξ± β πβ¦Objβ¦"
unfolding cat_FUNCT_components
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_FUNCT_cs_intros)
from assms(1-3) show "ntcf_arrow Ξ΅ :
?ππβ¦ObjMapβ¦β¦?πβ¦ β¦βcat_FUNCT Ξ± π
πβ ?π"
by
(
cs_concl
cs_simp: cat_Kan_cs_simps cat_FUNCT_cs_simps cat_FUNCT_components(1)
cs_intro: cat_FUNCT_cs_intros
)
fix π' Ξ΅' assume prems:
"π' ββ©β cat_FUNCT Ξ± β πβ¦Objβ¦"
"Ξ΅' : ?ππβ¦ObjMapβ¦β¦π'β¦ β¦βcat_FUNCT Ξ± π
πβ ?π"
from prems(1) have "π' ββ©β cf_maps Ξ± β π"
unfolding cat_FUNCT_components(1) by simp
then obtain π where π'_def: "π' = cf_map π" and π: "π : β β¦β¦β©CβΞ±β π"
by clarsimp
note Ξ΅' = cat_FUNCT_is_arrD[OF prems(2)]
from Ξ΅'(1) π have Ξ΅'_is_ntcf:
"ntcf_of_ntcf_arrow π
π Ξ΅' : π ββ©Cβ©F π β¦β©Cβ©F π : π
β¦β¦β©CβΞ±β π"
by
(
cs_prems
cs_simp: π'_def cat_Kan_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
from assms(4)[OF π Ξ΅'_is_ntcf] obtain Ο
where Ο: "Ο : π β¦β©Cβ©F π : β β¦β¦β©CβΞ±β π"
and Ξ΅'_def': "ntcf_of_ntcf_arrow π
π Ξ΅' = Ξ΅ ββ©Nβ©Tβ©Cβ©F (Ο ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π)"
and unique_Ο: "βΟ'.
β¦
Ο' : π β¦β©Cβ©F π : β β¦β¦β©CβΞ±β π;
ntcf_of_ntcf_arrow π
π Ξ΅' = Ξ΅ ββ©Nβ©Tβ©Cβ©F (Ο' ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π)
β§ βΉ Ο' = Ο"
by metis
show "β!f'.
f' : π' β¦βcat_FUNCT Ξ± β πβ ?π β§
Ξ΅' = umap_fo ?ππ ?π ?π (ntcf_arrow Ξ΅) π'β¦ArrValβ¦β¦f'β¦"
proof(intro ex1I conjI; (elim conjE)?, unfold π'_def)
from Ο show "ntcf_arrow Ο : cf_map π β¦βcat_FUNCT Ξ± β πβ ?π"
by (cs_concl cs_intro: cat_FUNCT_cs_intros)
from Ξ±Ξ² assms(1-3) Ο Ξ΅'(1) show
"Ξ΅' = umap_fo
?ππ ?π ?π (ntcf_arrow Ξ΅) (cf_map π)β¦ArrValβ¦β¦ntcf_arrow Οβ¦"
by (subst Ξ΅')
(
cs_concl
cs_simp:
Ξ΅'_def'[symmetric] cat_cs_simps cat_FUNCT_cs_simps cat_Kan_cs_simps
cs_intro:
cat_small_cs_intros
cat_cs_intros
cat_Kan_cs_intros
cat_FUNCT_cs_intros
)
fix Ο' assume prems:
"Ο' : cf_map π β¦βcat_FUNCT Ξ± β πβ ?π"
"Ξ΅' = umap_fo ?ππ ?π ?π (ntcf_arrow Ξ΅) (cf_map π)β¦ArrValβ¦β¦Ο'β¦"
note Ο' = cat_FUNCT_is_arrD[OF prems(1)]
from Ο'(1) π have "ntcf_of_ntcf_arrow β π Ο' : π β¦β©Cβ©F π : β β¦β¦β©CβΞ±β π"
by (cs_prems cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
moreover from prems(2) prems(1) Ξ±Ξ² assms(1-3) this Ξ΅'(1) have
"ntcf_of_ntcf_arrow π
π Ξ΅' =
Ξ΅ ββ©Nβ©Tβ©Cβ©F (ntcf_of_ntcf_arrow β π Ο' ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π)"
by (subst (asm) Ξ΅'(2))
(
cs_prems
cs_simp: cat_Kan_cs_simps cat_FUNCT_cs_simps cat_cs_simps
cs_intro:
cat_Kan_cs_intros
cat_small_cs_intros
cat_cs_intros
cat_FUNCT_cs_intros
)
ultimately have Ο_def: "Ο = ntcf_of_ntcf_arrow β π Ο'"
by (rule unique_Ο[symmetric])
show "Ο' = ntcf_arrow Ο"
by (subst Ο'(2), use nothing in βΉsubst Ο_defβΊ)
(cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
qed
qed
lemma is_cat_lKeI':
assumes "π : π
β¦β¦β©CβΞ±β β"
and "π : β β¦β¦β©CβΞ±β π"
and "Ξ· : π β¦β©Cβ©F π ββ©Cβ©F π : π
β¦β¦β©CβΞ±β π"
and "βπ' Ξ·'.
β¦ π' : β β¦β¦β©CβΞ±β π; Ξ·' : π β¦β©Cβ©F π' ββ©Cβ©F π : π
β¦β¦β©CβΞ±β π β§ βΉ
β!Ο. Ο : π β¦β©Cβ©F π' : β β¦β¦β©CβΞ±β π β§ Ξ·' = (Ο ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π) ββ©Nβ©Tβ©Cβ©F Ξ·"
shows "Ξ· : π β¦β©Cβ©Fβ©.β©lβ©Kβ©eβΞ±β π ββ©Cβ©F π : π
β¦β©C β β¦β©C π"
proof-
interpret π: is_functor Ξ± π
β π by (rule assms(1))
interpret π: is_functor Ξ± β π π by (rule assms(2))
interpret Ξ·: is_ntcf Ξ± π
π π βΉπ ββ©Cβ©F πβΊ Ξ· by (rule assms(3))
have
"β!Ο.
Ο : π' β¦β©Cβ©F op_cf π : op_cat β β¦β¦β©CβΞ±β op_cat π β§
Ξ·' = op_ntcf Ξ· ββ©Nβ©Tβ©Cβ©F (Ο ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F op_cf π)"
if "π' : op_cat β β¦β¦β©CβΞ±β op_cat π"
and "Ξ·' : π' ββ©Cβ©F op_cf π β¦β©Cβ©F op_cf π : op_cat π
β¦β¦β©CβΞ±β op_cat π"
for π' Ξ·'
proof-
interpret π': is_functor Ξ± βΉop_cat ββΊ βΉop_cat πβΊ π' by (rule that(1))
interpret Ξ·':
is_ntcf Ξ± βΉop_cat π
βΊ βΉop_cat πβΊ βΉπ' ββ©Cβ©F op_cf πβΊ βΉop_cf πβΊ Ξ·'
by (rule that(2))
from assms(4)[
OF is_functor.is_functor_op[OF that(1), unfolded cat_op_simps],
OF is_ntcf.is_ntcf_op[OF that(2), unfolded cat_op_simps]
]
obtain Ο where Ο: "Ο : π β¦β©Cβ©F op_cf π' : β β¦β¦β©CβΞ±β π"
and op_Ξ·'_def: "op_ntcf Ξ·' = Ο ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π ββ©Nβ©Tβ©Cβ©F Ξ·"
and unique_Ο':
"β¦
Ο' : π β¦β©Cβ©F op_cf π' : β β¦β¦β©CβΞ±β π;
op_ntcf Ξ·' = Ο' ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π ββ©Nβ©Tβ©Cβ©F Ξ·
β§ βΉ Ο' = Ο"
for Ο'
by metis
interpret Ο: is_ntcf Ξ± β π π βΉop_cf π'βΊ Ο by (rule Ο)
show ?thesis
proof(intro ex1I conjI; (elim conjE)?)
show "op_ntcf Ο : π' β¦β©Cβ©F op_cf π : op_cat β β¦β¦β©CβΞ±β op_cat π"
by (rule Ο.is_ntcf_op[unfolded cat_op_simps])
from op_Ξ·'_def have "op_ntcf (op_ntcf Ξ·') = op_ntcf (Ο ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π ββ©Nβ©Tβ©Cβ©F Ξ·)"
by simp
from this Ο assms(1-3) show Ξ·'_def:
"Ξ·' = op_ntcf Ξ· ββ©Nβ©Tβ©Cβ©F (op_ntcf Ο ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F op_cf π)"
by (cs_prems cs_simp: cat_op_simps cs_intro: cat_cs_intros)
fix Ο' assume prems:
"Ο' : π' β¦β©Cβ©F op_cf π : op_cat β β¦β¦β©CβΞ±β op_cat π"
"Ξ·' = op_ntcf Ξ· ββ©Nβ©Tβ©Cβ©F (Ο' ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F op_cf π)"
interpret Ο': is_ntcf Ξ± βΉop_cat ββΊ βΉop_cat πβΊ π' βΉop_cf πβΊ Ο'
by (rule prems(1))
from prems(2) have
"op_ntcf Ξ·' = op_ntcf (op_ntcf Ξ· ββ©Nβ©Tβ©Cβ©F (Ο' ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F op_cf π))"
by simp
also have "β¦ = op_ntcf Ο' ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π ββ©Nβ©Tβ©Cβ©F Ξ·"
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros
)
finally have "op_ntcf Ξ·' = op_ntcf Ο' ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π ββ©Nβ©Tβ©Cβ©F Ξ·" by simp
from unique_Ο'[OF Ο'.is_ntcf_op[unfolded cat_op_simps] this] show
"Ο' = op_ntcf Ο"
by (auto simp: cat_op_simps)
qed
qed
from
is_cat_rKeI'
[
OF π.is_functor_op π.is_functor_op Ξ·.is_ntcf_op[unfolded cat_op_simps],
unfolded cat_op_simps,
OF this
]
interpret Ξ·: is_cat_rKe
Ξ±
βΉop_cat π
βΊ
βΉop_cat ββΊ
βΉop_cat πβΊ
βΉop_cf πβΊ
βΉop_cf πβΊ
βΉop_cf πβΊ
βΉop_ntcf Ξ·βΊ
by simp
show "Ξ· : π β¦β©Cβ©Fβ©.β©lβ©Kβ©eβΞ±β π ββ©Cβ©F π : π
β¦β©C β β¦β©C π"
by (rule Ξ·.is_cat_lKe_op[unfolded cat_op_simps])
qed
lemma (in is_cat_rKe) cat_rKe_unique:
assumes "π' : β β¦β¦β©CβΞ±β π" and "Ξ΅' : π' ββ©Cβ©F π β¦β©Cβ©F π : π
β¦β¦β©CβΞ±β π"
shows "β!Ο. Ο : π' β¦β©Cβ©F π : β β¦β¦β©CβΞ±β π β§ Ξ΅' = Ξ΅ ββ©Nβ©Tβ©Cβ©F (Ο ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π)"
proof-
interpret π': is_functor Ξ± β π π' by (rule assms(1))
interpret Ξ΅': is_ntcf Ξ± π
π βΉπ' ββ©Cβ©F πβΊ π Ξ΅' by (rule assms(2))
let ?π = βΉcf_map πβΊ
and ?π = βΉcf_map πβΊ
and ?π' = βΉcf_map π'βΊ
and ?Ξ΅ = βΉntcf_arrow Ξ΅βΊ
and ?Ξ΅' = βΉntcf_arrow Ξ΅'βΊ
define Ξ² where "Ξ² = Ξ± + Ο"
have "π΅ Ξ²" and Ξ±Ξ²: "Ξ± ββ©β Ξ²"
by (simp_all add: Ξ²_def AG.π΅_Limit_Ξ±Ο AG.π΅_Ο_Ξ±Ο π΅_def AG.π΅_Ξ±_Ξ±Ο)
then interpret Ξ²: π΅ Ξ² by simp
interpret ππ: is_tiny_functor
Ξ² βΉcat_FUNCT Ξ± β πβΊ βΉcat_FUNCT Ξ± π
πβΊ βΉexp_cat_cf Ξ± π πβΊ
by (rule cat_rKe_exp_cat_cf_cat_FUNCT_is_arr[OF Ξ².π΅_axioms Ξ±Ξ²])
from assms(1) have π': "?π' ββ©β cat_FUNCT Ξ± β πβ¦Objβ¦"
by (cs_concl cs_simp: cat_FUNCT_components(1) cs_intro: cat_FUNCT_cs_intros)
with assms(2) have
"?Ξ΅' : exp_cat_cf Ξ± π πβ¦ObjMapβ¦β¦?π'β¦ β¦βcat_FUNCT Ξ± π
πβ ?π"
by
(
cs_concl
cs_simp: cat_Kan_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
from
is_functor.universal_arrow_foD(3)[
OF ππ.is_functor_axioms cat_rKe_ua_fo π' this
]
obtain f' where f': "f' : cf_map π' β¦βcat_FUNCT Ξ± β πβ cf_map π"
and Ξ΅'_def: "?Ξ΅' = umap_fo (exp_cat_cf Ξ± π π) ?π ?π ?Ξ΅ ?π'β¦ArrValβ¦β¦f'β¦"
and f'_unique:
"β¦
f'' : ?π' β¦βcat_FUNCT Ξ± β πβ ?π;
ntcf_arrow Ξ΅' = umap_fo (exp_cat_cf Ξ± π π) ?π ?π ?Ξ΅ ?π'β¦ArrValβ¦β¦f''β¦
β§ βΉ f'' = f'"
for f''
by metis
show ?thesis
proof(intro ex1I conjI; (elim conjE)?)
from Ξ΅'_def cat_FUNCT_is_arrD(1)[OF f'] show
"Ξ΅' = Ξ΅ ββ©Nβ©Tβ©Cβ©F (ntcf_of_ntcf_arrow β π f' ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π)"
by (subst (asm) cat_FUNCT_is_arrD(2)[OF f'])
(
cs_prems
cs_simp: cat_cs_simps cat_FUNCT_cs_simps cat_Kan_cs_simps
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
from cat_FUNCT_is_arrD(1)[OF f'] show f'_is_arr:
"ntcf_of_ntcf_arrow β π f' : π' β¦β©Cβ©F π : β β¦β¦β©CβΞ±β π"
by (cs_prems cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
fix Ο assume prems:
"Ο : π' β¦β©Cβ©F π : β β¦β¦β©CβΞ±β π" "Ξ΅' = Ξ΅ ββ©Nβ©Tβ©Cβ©F (Ο ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π)"
interpret Ο: is_ntcf Ξ± β π π' π Ο by (rule prems(1))
from prems(1) have Ο:
"ntcf_arrow Ο : cf_map π' β¦βcat_FUNCT Ξ± β πβ cf_map π"
by (cs_concl cs_intro: cat_FUNCT_cs_intros)
from prems have Ξ΅'_def: "ntcf_arrow Ξ΅' =
umap_fo (exp_cat_cf Ξ± π π) ?π ?π ?Ξ΅ ?π'β¦ArrValβ¦β¦ntcf_arrow Οβ¦"
by
(
cs_concl
cs_simp: prems(2) cat_Kan_cs_simps cat_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
show "Ο = ntcf_of_ntcf_arrow β π f'"
unfolding f'_unique[OF Ο Ξ΅'_def, symmetric]
by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
qed
qed
lemma (in is_cat_lKe) cat_lKe_unique:
assumes "π' : β β¦β¦β©CβΞ±β π" and "Ξ·' : π β¦β©Cβ©F π' ββ©Cβ©F π : π
β¦β¦β©CβΞ±β π"
shows "β!Ο. Ο : π β¦β©Cβ©F π' : β β¦β¦β©CβΞ±β π β§ Ξ·' = (Ο ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π) ββ©Nβ©Tβ©Cβ©F Ξ·"
proof-
interpret π': is_functor Ξ± β π π' by (rule assms(1))
interpret Ξ·': is_ntcf Ξ± π
π π βΉπ' ββ©Cβ©F πβΊ Ξ·' by (rule assms(2))
interpret Ξ·: is_cat_rKe
Ξ± βΉop_cat π
βΊ βΉop_cat ββΊ βΉop_cat πβΊ βΉop_cf πβΊ βΉop_cf πβΊ βΉop_cf πβΊ βΉop_ntcf Ξ·βΊ
by (rule is_cat_rKe_op)
from Ξ·.cat_rKe_unique[OF π'.is_functor_op Ξ·'.is_ntcf_op[unfolded cat_op_simps]]
obtain Ο where Ο: "Ο : op_cf π' β¦β©Cβ©F op_cf π : op_cat β β¦β¦β©CβΞ±β op_cat π"
and Ξ·'_def: "op_ntcf Ξ·' = op_ntcf Ξ· ββ©Nβ©Tβ©Cβ©F (Ο ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F op_cf π)"
and unique_Ο': "βΟ'.
β¦
Ο' : op_cf π' β¦β©Cβ©F op_cf π : op_cat β β¦β¦β©CβΞ±β op_cat π;
op_ntcf Ξ·' = op_ntcf Ξ· ββ©Nβ©Tβ©Cβ©F (Ο' ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F op_cf π)
β§ βΉ Ο' = Ο"
by metis
interpret Ο: is_ntcf Ξ± βΉop_cat ββΊ βΉop_cat πβΊ βΉop_cf π'βΊ βΉop_cf πβΊ Ο
by (rule Ο)
show ?thesis
proof(intro ex1I conjI; (elim conjE)?)
show "op_ntcf Ο : π β¦β©Cβ©F π' : β β¦β¦β©CβΞ±β π"
by (rule Ο.is_ntcf_op[unfolded cat_op_simps])
have "Ξ·' = op_ntcf (op_ntcf Ξ·')" by (cs_concl cs_simp: cat_op_simps)
also from Ξ·'_def have "β¦ = op_ntcf (op_ntcf Ξ· ββ©Nβ©Tβ©Cβ©F (Ο ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F op_cf π))"
by simp
also have "β¦ = op_ntcf Ο ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π ββ©Nβ©Tβ©Cβ©F Ξ·"
by (cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros)
finally show "Ξ·' = op_ntcf Ο ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π ββ©Nβ©Tβ©Cβ©F Ξ·" by simp
fix Ο' assume prems:
"Ο' : π β¦β©Cβ©F π' : β β¦β¦β©CβΞ±β π"
"Ξ·' = Ο' ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π ββ©Nβ©Tβ©Cβ©F Ξ·"
interpret Ο': is_ntcf Ξ± β π π π' Ο' by (rule prems(1))
from prems(2) have "op_ntcf Ξ·' = op_ntcf (Ο' ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π ββ©Nβ©Tβ©Cβ©F Ξ·)"
by simp
also have "β¦ = op_ntcf Ξ· ββ©Nβ©Tβ©Cβ©F (op_ntcf Ο' ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F op_cf π)"
by (cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros)
finally have "op_ntcf Ξ·' = op_ntcf Ξ· ββ©Nβ©Tβ©Cβ©F (op_ntcf Ο' ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F op_cf π)"
by simp
from unique_Ο'[OF Ο'.is_ntcf_op this] show "Ο' = op_ntcf Ο"
by (auto simp: cat_op_simps)
qed
qed
subsubsectionβΉFurther propertiesβΊ
lemma (in is_cat_rKe) cat_rKe_ntcf_ua_fo_is_iso_ntcf_if_ge_Limit:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²"
shows
"ntcf_ua_fo Ξ² (exp_cat_cf Ξ± π π) (cf_map π) (cf_map π) (ntcf_arrow Ξ΅) :
Homβ©Oβ©.β©CβΞ²βcat_FUNCT Ξ± β π(-,cf_map π) β¦β©Cβ©Fβ©.β©iβ©sβ©o
Homβ©Oβ©.β©CβΞ²βcat_FUNCT Ξ± π
π(-,cf_map π) ββ©Cβ©F op_cf (exp_cat_cf Ξ± π π) :
op_cat (cat_FUNCT Ξ± β π) β¦β¦β©CβΞ²β cat_Set Ξ²"
proof-
interpret π_π:
is_tiny_functor Ξ² βΉcat_FUNCT Ξ± β πβΊ βΉcat_FUNCT Ξ± π
πβΊ βΉexp_cat_cf Ξ± π πβΊ
by
(
rule exp_cat_cf_is_tiny_functor[
OF assms Ran.HomCod.category_axioms AG.is_functor_axioms
]
)
show ?thesis
by
(
rule is_functor.cf_ntcf_ua_fo_is_iso_ntcf[
OF π_π.is_functor_axioms cat_rKe_ua_fo
]
)
qed
lemma (in is_cat_lKe) cat_lKe_ntcf_ua_fo_is_iso_ntcf_if_ge_Limit:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²"
defines "ππ β‘ exp_cat_cf Ξ± (op_cat π) (op_cf π)"
and "πβ β‘ cat_FUNCT Ξ± (op_cat β) (op_cat π)"
and "ππ
β‘ cat_FUNCT Ξ± (op_cat π
) (op_cat π)"
shows
"ntcf_ua_fo Ξ² ππ (cf_map π) (cf_map π) (ntcf_arrow (op_ntcf Ξ·)) :
Homβ©Oβ©.β©CβΞ²βπβ(-,cf_map π) β¦β©Cβ©Fβ©.β©iβ©sβ©o Homβ©Oβ©.β©CβΞ²βππ
(-,cf_map π) ββ©Cβ©F op_cf ππ :
op_cat πβ β¦β¦β©CβΞ²β cat_Set Ξ²"
proof-
note simps = πβ_def ππ
_def ππ_def
interpret π_π: is_tiny_functor Ξ² πβ ππ
ππ
unfolding simps
by
(
rule exp_cat_cf_is_tiny_functor[
OF assms(1,2) Lan.HomCod.category_op AG.is_functor_op
]
)
show ?thesis
unfolding simps
by
(
rule is_functor.cf_ntcf_ua_fo_is_iso_ntcf[
OF π_π.is_functor_axioms[unfolded simps] cat_lKe_ua_fo
]
)
qed
subsectionβΉThe Kan extensionβΊ
textβΉ
The following subsection is based on the statement and proof of
Theorem 1 in Chapter X-3 in \cite{mac_lane_categories_2010}.
In what follows, only the right Kan extension is considered for simplicity.
βΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition the_cf_rKe :: "V β V β V β (V β V) β V"
where "the_cf_rKe Ξ± π π lim_Obj =
[
(Ξ»cββ©βπβ¦HomCodβ¦β¦Objβ¦. lim_Obj cβ¦UObjβ¦),
(
Ξ»gββ©βπβ¦HomCodβ¦β¦Arrβ¦. THE f.
f :
lim_Obj (πβ¦HomCodβ¦β¦Domβ¦β¦gβ¦)β¦UObjβ¦ β¦βπβ¦HomCodβ¦β
lim_Obj (πβ¦HomCodβ¦β¦Codβ¦β¦gβ¦)β¦UObjβ¦ β§
lim_Obj (πβ¦HomCodβ¦β¦Domβ¦β¦gβ¦)β¦UArrβ¦ ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F g β©Aββ©Cβ©F π =
lim_Obj (πβ¦HomCodβ¦β¦Codβ¦β¦gβ¦)β¦UArrβ¦ ββ©Nβ©Tβ©Cβ©F
ntcf_const ((πβ¦HomCodβ¦β¦Codβ¦β¦gβ¦) ββ©Cβ©F π) (πβ¦HomCodβ¦) f
),
πβ¦HomCodβ¦,
πβ¦HomCodβ¦
]β©β"
definition the_ntcf_rKe :: "V β V β V β (V β V) β V"
where "the_ntcf_rKe Ξ± π π lim_Obj =
[
(
Ξ»cββ©βπβ¦HomDomβ¦β¦Objβ¦.
lim_Obj (πβ¦ObjMapβ¦β¦cβ¦)β¦UArrβ¦β¦NTMapβ¦β¦0, c, πβ¦HomCodβ¦β¦CIdβ¦β¦πβ¦ObjMapβ¦β¦cβ¦β¦β¦β©β
),
the_cf_rKe Ξ± π π lim_Obj ββ©Cβ©F π,
π,
πβ¦HomDomβ¦,
πβ¦HomCodβ¦
]β©β"
textβΉComponents.βΊ
lemma the_cf_rKe_components:
shows "the_cf_rKe Ξ± π π lim_Objβ¦ObjMapβ¦ =
(Ξ»cββ©βπβ¦HomCodβ¦β¦Objβ¦. lim_Obj cβ¦UObjβ¦)"
and "the_cf_rKe Ξ± π π lim_Objβ¦ArrMapβ¦ =
(
Ξ»gββ©βπβ¦HomCodβ¦β¦Arrβ¦. THE f.
f :
lim_Obj (πβ¦HomCodβ¦β¦Domβ¦β¦gβ¦)β¦UObjβ¦ β¦βπβ¦HomCodβ¦β
lim_Obj (πβ¦HomCodβ¦β¦Codβ¦β¦gβ¦)β¦UObjβ¦ β§
lim_Obj (πβ¦HomCodβ¦β¦Domβ¦β¦gβ¦)β¦UArrβ¦ ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F g β©Aββ©Cβ©F π =
lim_Obj (πβ¦HomCodβ¦β¦Codβ¦β¦gβ¦)β¦UArrβ¦ ββ©Nβ©Tβ©Cβ©F
ntcf_const ((πβ¦HomCodβ¦β¦Codβ¦β¦gβ¦) ββ©Cβ©F π) (πβ¦HomCodβ¦) f
)"
and "the_cf_rKe Ξ± π π lim_Objβ¦HomDomβ¦ = πβ¦HomCodβ¦"
and "the_cf_rKe Ξ± π π lim_Objβ¦HomCodβ¦ = πβ¦HomCodβ¦"
unfolding the_cf_rKe_def dghm_field_simps by (simp_all add: nat_omega_simps)
lemma the_ntcf_rKe_components:
shows "the_ntcf_rKe Ξ± π π lim_Objβ¦NTMapβ¦ =
(
Ξ»cββ©βπβ¦HomDomβ¦β¦Objβ¦.
lim_Obj (πβ¦ObjMapβ¦β¦cβ¦)β¦UArrβ¦β¦NTMapβ¦β¦0, c, πβ¦HomCodβ¦β¦CIdβ¦β¦πβ¦ObjMapβ¦β¦cβ¦β¦β¦β©β
)"
and "the_ntcf_rKe Ξ± π π lim_Objβ¦NTDomβ¦ = the_cf_rKe Ξ± π π lim_Obj ββ©Cβ©F π"
and "the_ntcf_rKe Ξ± π π lim_Objβ¦NTCodβ¦ = π"
and "the_ntcf_rKe Ξ± π π lim_Objβ¦NTDGDomβ¦ = πβ¦HomDomβ¦"
and "the_ntcf_rKe Ξ± π π lim_Objβ¦NTDGCodβ¦ = πβ¦HomCodβ¦"
unfolding the_ntcf_rKe_def nt_field_simps by (simp_all add: nat_omega_simps)
context
fixes Ξ± π π
β π π
assumes π: "π : π
β¦β¦β©CβΞ±β β"
and π: "π : π
β¦β¦β©CβΞ±β π"
begin
interpretation π: is_functor Ξ± π
β π by (rule π)
interpretation π: is_functor Ξ± π
π π by (rule π)
lemmas the_cf_rKe_components' = the_cf_rKe_components[
where π=π and π=π and Ξ±=Ξ±, unfolded π.cf_HomCod π.cf_HomCod
]
lemmas [cat_Kan_cs_simps] = the_cf_rKe_components'(3,4)
lemmas the_ntcf_rKe_components' = the_ntcf_rKe_components[
where π=π and π=π and Ξ±=Ξ±, unfolded π.cf_HomCod π.cf_HomCod π.cf_HomDom
]
lemmas [cat_Kan_cs_simps] = the_ntcf_rKe_components'(2-5)
end
subsubsectionβΉFunctor: object mapβΊ
mk_VLambda the_cf_rKe_components(1)
|vsv the_cf_rKe_ObjMap_vsv[cat_Kan_cs_intros]|
context
fixes Ξ± π π
β π π
assumes π: "π : π
β¦β¦β©CβΞ±β β"
and π: "π : π
β¦β¦β©CβΞ±β π"
begin
interpretation π: is_functor Ξ± π
β π by (rule π)
mk_VLambda the_cf_rKe_components'(1)[OF π π]
|vdomain the_cf_rKe_ObjMap_vdomain[cat_Kan_cs_simps]|
|app the_cf_rKe_ObjMap_impl_app[cat_Kan_cs_simps]|
lemma the_cf_rKe_ObjMap_vrange:
assumes "βc. c ββ©β ββ¦Objβ¦ βΉ lim_Obj cβ¦UObjβ¦ ββ©β πβ¦Objβ¦"
shows "ββ©β (the_cf_rKe Ξ± π π lim_Objβ¦ObjMapβ¦) ββ©β πβ¦Objβ¦"
unfolding the_cf_rKe_components'[OF π π]
by (intro vrange_VLambda_vsubset assms)
end
subsubsectionβΉFunctor: arrow mapβΊ
mk_VLambda the_cf_rKe_components(2)
|vsv the_cf_rKe_ArrMap_vsv[cat_Kan_cs_intros]|
context
fixes Ξ± π
β π
assumes π: "π : π
β¦β¦β©CβΞ±β β"
begin
interpretation π: is_functor Ξ± π
β π by (rule π)
mk_VLambda the_cf_rKe_components(2)[where Ξ±=Ξ± and π=π, unfolded π.cf_HomCod]
|vdomain the_cf_rKe_ArrMap_vdomain[cat_Kan_cs_simps]|
context
fixes π π c c' g
assumes π: "π : π
β¦β¦β©CβΞ±β π"
and g: "g : c β¦βββ c'"
begin
interpretation π: is_functor Ξ± π
π π by (rule π)
lemma g': "g ββ©β ββ¦Arrβ¦" using g by auto
mk_VLambda the_cf_rKe_components(2)[
where Ξ±=Ξ± and π=π and π=π, unfolded π.cf_HomCod π.cf_HomCod
]
|app the_cf_rKe_ArrMap_app_impl'|
lemmas the_cf_rKe_ArrMap_app' = the_cf_rKe_ArrMap_app_impl'[
OF g', unfolded π.HomCod.cat_is_arrD[OF g]
]
end
end
lemma the_cf_rKe_ArrMap_app_impl:
assumes "π : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
and "π : π
β¦β¦β©CβΞ±β π"
and "g : c β¦βββ c'"
and "u : r <β©Cβ©Fβ©.β©lβ©iβ©m π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π : c ββ©Cβ©F π β¦β¦β©CβΞ±β π"
and "u' : r' <β©Cβ©Fβ©.β©lβ©iβ©m π ββ©Cβ©F c' β©Oβ¨
β©Cβ©F π : c' ββ©Cβ©F π β¦β¦β©CβΞ±β π"
shows "β!f.
f : r β¦βπβ r' β§
u ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F g β©Aββ©Cβ©F π = u' ββ©Nβ©Tβ©Cβ©F ntcf_const (c' ββ©Cβ©F π) π f"
proof-
interpret π: is_tm_functor Ξ± π
β π by (rule assms(1))
interpret π: is_functor Ξ± π
π π by (rule assms(2))
interpret u: is_cat_limit Ξ± βΉc ββ©Cβ©F πβΊ π βΉπ ββ©Cβ©F c β©Oβ¨
β©Cβ©F πβΊ r u
by (rule assms(4))
interpret u': is_cat_limit Ξ± βΉc' ββ©Cβ©F πβΊ π βΉπ ββ©Cβ©F c' β©Oβ¨
β©Cβ©F πβΊ r' u'
by (rule assms(5))
have const_r_def:
"cf_const (c' ββ©Cβ©F π) π r = cf_const (c ββ©Cβ©F π) π r ββ©Cβ©F g β©Aββ©Cβ©F π"
proof(rule cf_eqI)
show const_r: "cf_const (c' ββ©Cβ©F π) π r : c' ββ©Cβ©F π β¦β¦β©CβΞ±β π"
by (cs_concl cs_intro: cat_cs_intros cat_lim_cs_intros)
from assms(3) show const_r_gπ:
"cf_const (c ββ©Cβ©F π) π r ββ©Cβ©F g β©Aββ©Cβ©F π : c' ββ©Cβ©F π β¦β¦β©CβΞ±β π"
by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
have ObjMap_dom_lhs: "πβ©β (cf_const (c' ββ©Cβ©F π) π rβ¦ObjMapβ¦) = c' ββ©Cβ©F πβ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms(3) have ObjMap_dom_rhs:
"πβ©β ((cf_const (c ββ©Cβ©F π) π r ββ©Cβ©F g β©Aββ©Cβ©F π)β¦ObjMapβ¦) = c' ββ©Cβ©F πβ¦Objβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_comma_cs_intros
)
have ArrMap_dom_lhs: "πβ©β (cf_const (c' ββ©Cβ©F π) π rβ¦ArrMapβ¦) = c' ββ©Cβ©F πβ¦Arrβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms(3) have ArrMap_dom_rhs:
"πβ©β ((cf_const (c ββ©Cβ©F π) π r ββ©Cβ©F g β©Aββ©Cβ©F π)β¦ArrMapβ¦) = c' ββ©Cβ©F πβ¦Arrβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_comma_cs_intros
)
show
"cf_const (c' ββ©Cβ©F π) π rβ¦ObjMapβ¦ =
(cf_const (c ββ©Cβ©F π) π r ββ©Cβ©F g β©Aββ©Cβ©F π)β¦ObjMapβ¦"
proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
fix A assume prems: "A ββ©β c' ββ©Cβ©F πβ¦Objβ¦"
from prems assms obtain b f
where A_def: "A = [0, b, f]β©β"
and b: "b ββ©β π
β¦Objβ¦"
and f: "f : c' β¦βββ πβ¦ObjMapβ¦β¦bβ¦"
by auto
from assms(1,3) prems f b show
"cf_const (c' ββ©Cβ©F π) π rβ¦ObjMapβ¦β¦Aβ¦ =
(cf_const (c ββ©Cβ©F π) π r ββ©Cβ©F g β©Aββ©Cβ©F π)β¦ObjMapβ¦β¦Aβ¦"
unfolding A_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_comma_cs_simps
cs_intro: cat_cs_intros cat_comma_cs_intros
)
qed (use assms(3) in βΉcs_concl cs_intro: cat_cs_intros cat_comma_cs_introsβΊ)+
show
"cf_const (c' ββ©Cβ©F π) π rβ¦ArrMapβ¦ =
(cf_const (c ββ©Cβ©F π) π r ββ©Cβ©F g β©Aββ©Cβ©F π)β¦ArrMapβ¦"
proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
show "vsv (cf_const (c' ββ©Cβ©F π) π rβ¦ArrMapβ¦)"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms(3) show "vsv ((cf_const (c ββ©Cβ©F π) π r ββ©Cβ©F g β©Aββ©Cβ©F π)β¦ArrMapβ¦)"
by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
fix F assume prems: "F ββ©β c' ββ©Cβ©F πβ¦Arrβ¦"
with prems obtain A B where F: "F : A β¦βc' ββ©Cβ©F πβ B"
by (auto intro: is_arrI)
with assms obtain b f b' f' h'
where F_def: "F = [[0, b, f]β©β, [0, b', f']β©β, [0, h']β©β]β©β"
and A_def: "A = [0, b, f]β©β"
and B_def: "B = [0, b', f']β©β"
and h': "h' : b β¦βπ
β b'"
and f: "f : c' β¦βββ πβ¦ObjMapβ¦β¦bβ¦"
and f': "f' : c' β¦βββ πβ¦ObjMapβ¦β¦b'β¦"
and f'_def: "πβ¦ArrMapβ¦β¦h'β¦ ββ©Aβββ f = f'"
by auto
from prems assms(3) F g' h' f f' show
"cf_const (c' ββ©Cβ©F π) π rβ¦ArrMapβ¦β¦Fβ¦ =
(cf_const (c ββ©Cβ©F π) π r ββ©Cβ©F g β©Aββ©Cβ©F π)β¦ArrMapβ¦β¦Fβ¦"
unfolding F_def A_def B_def
by
(
cs_concl
cs_simp: cat_comma_cs_simps cat_cs_simps f'_def[symmetric]
cs_intro: cat_cs_intros cat_comma_cs_intros
)
qed simp
qed simp_all
have πc'π: "π ββ©Cβ©F c' β©Oβ¨
β©Cβ©F π = π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π ββ©Cβ©F g β©Aββ©Cβ©F π"
proof(rule cf_eqI)
show "π ββ©Cβ©F c' β©Oβ¨
β©Cβ©F π : c' ββ©Cβ©F π β¦β¦β©CβΞ±β π"
by (cs_concl cs_intro: cat_cs_intros)
from assms show " π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π ββ©Cβ©F g β©Aββ©Cβ©F π : c' ββ©Cβ©F π β¦β¦β©CβΞ±β π"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_comma_cs_intros cat_cs_intros
)
have ObjMap_dom_lhs: "πβ©β ((π ββ©Cβ©F c' β©Oβ¨
β©Cβ©F π)β¦ObjMapβ¦) = c' ββ©Cβ©F πβ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms have ObjMap_dom_rhs:
"πβ©β ((π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π ββ©Cβ©F g β©Aββ©Cβ©F π)β¦ObjMapβ¦) = c' ββ©Cβ©F πβ¦Objβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_comma_cs_intros cat_cs_intros
)
show "(π ββ©Cβ©F c' β©Oβ¨
β©Cβ©F π)β¦ObjMapβ¦ = (π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π ββ©Cβ©F g β©Aββ©Cβ©F π)β¦ObjMapβ¦"
proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
from assms show "vsv ((π ββ©Cβ©F c' β©Oβ¨
β©Cβ©F π)β¦ObjMapβ¦)"
by
(
cs_concl
cs_simp: cat_comma_cs_simps
cs_intro: cat_cs_intros cat_comma_cs_intros
)
from assms show "vsv ((π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π ββ©Cβ©F g β©Aββ©Cβ©F π)β¦ObjMapβ¦)"
by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
fix A assume prems: "A ββ©β c' ββ©Cβ©F πβ¦Objβ¦"
from assms(3) prems obtain b f
where A_def: "A = [0, b, f]β©β"
and b: "b ββ©β π
β¦Objβ¦"
and f: "f : c' β¦βββ πβ¦ObjMapβ¦β¦bβ¦"
by auto
from prems assms b f show
"(π ββ©Cβ©F c' β©Oβ¨
β©Cβ©F π)β¦ObjMapβ¦β¦Aβ¦ =
(π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π ββ©Cβ©F g β©Aββ©Cβ©F π)β¦ObjMapβ¦β¦Aβ¦"
unfolding A_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_comma_cs_simps
cs_intro: cat_cs_intros cat_comma_cs_intros
)
qed simp
have ArrMap_dom_lhs: "πβ©β ((π ββ©Cβ©F c' β©Oβ¨
β©Cβ©F π)β¦ArrMapβ¦) = c' ββ©Cβ©F πβ¦Arrβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms have ArrMap_dom_rhs:
"πβ©β ((π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π ββ©Cβ©F g β©Aββ©Cβ©F π)β¦ArrMapβ¦) = c' ββ©Cβ©F πβ¦Arrβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_comma_cs_intros cat_cs_intros
)
show "(π ββ©Cβ©F c' β©Oβ¨
β©Cβ©F π)β¦ArrMapβ¦ = (π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π ββ©Cβ©F g β©Aββ©Cβ©F π)β¦ArrMapβ¦"
proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
from assms show "vsv ((π ββ©Cβ©F c' β©Oβ¨
β©Cβ©F π)β¦ArrMapβ¦)"
by
(
cs_concl
cs_simp: cat_comma_cs_simps
cs_intro: cat_cs_intros cat_comma_cs_intros
)
from assms show "vsv ((π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π ββ©Cβ©F g β©Aββ©Cβ©F π)β¦ArrMapβ¦)"
by (cs_concl cs_simp: cs_intro: cat_cs_intros cat_comma_cs_intros)
fix F assume prems: "F ββ©β c' ββ©Cβ©F πβ¦Arrβ¦"
with prems obtain A B where F: "F : A β¦βc' ββ©Cβ©F πβ B"
unfolding cat_comma_cs_simps by (auto intro: is_arrI)
with assms(3) obtain b f b' f' h'
where F_def: "F = [[0, b, f]β©β, [0, b', f']β©β, [0, h']β©β]β©β"
and A_def: "A = [0, b, f]β©β"
and B_def: "B = [0, b', f']β©β"
and h': "h' : b β¦βπ
β b'"
and f: "f : c' β¦βββ πβ¦ObjMapβ¦β¦bβ¦"
and f': "f' : c' β¦βββ πβ¦ObjMapβ¦β¦b'β¦"
and f'_def: "πβ¦ArrMapβ¦β¦h'β¦ ββ©Aβββ f = f'"
by auto
from prems assms(3) F g' h' f f' show
"(π ββ©Cβ©F c' β©Oβ¨
β©Cβ©F π)β¦ArrMapβ¦β¦Fβ¦ =
(π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π ββ©Cβ©F g β©Aββ©Cβ©F π)β¦ArrMapβ¦β¦Fβ¦"
unfolding F_def A_def B_def
by
(
cs_concl
cs_simp: cat_comma_cs_simps cat_cs_simps f'_def[symmetric]
cs_intro: cat_cs_intros cat_comma_cs_intros
)
qed simp
qed simp_all
from assms(1-3) have
"u ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F g β©Aββ©Cβ©F π : r <β©Cβ©Fβ©.β©cβ©oβ©nβ©e π ββ©Cβ©F c' β©Oβ¨
β©Cβ©F π : c' ββ©Cβ©F π β¦β¦β©CβΞ±β π"
by (intro is_cat_coneI is_tm_ntcfI')
(
cs_concl
cs_intro:
cat_cs_intros
cat_comma_cs_intros
cat_lim_cs_intros
cat_small_cs_intros
cs_simp: const_r_def πc'π
)+
with u'.cat_lim_unique_cone show
"β!G.
G : r β¦βπβ r' β§
u ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F g β©Aββ©Cβ©F π = u' ββ©Nβ©Tβ©Cβ©F ntcf_const (c' ββ©Cβ©F π) π G"
by simp
qed
lemma the_cf_rKe_ArrMap_app:
assumes "π : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
and "π : π
β¦β¦β©CβΞ±β π"
and "g : c β¦βββ c'"
and "lim_Obj cβ¦UArrβ¦ :
lim_Obj cβ¦UObjβ¦ <β©Cβ©Fβ©.β©lβ©iβ©m π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π : c ββ©Cβ©F π β¦β¦β©CβΞ±β π"
and "lim_Obj c'β¦UArrβ¦ :
lim_Obj c'β¦UObjβ¦ <β©Cβ©Fβ©.β©lβ©iβ©m π ββ©Cβ©F c' β©Oβ¨
β©Cβ©F π : c' ββ©Cβ©F π β¦β¦β©CβΞ±β π"
shows "the_cf_rKe Ξ± π π lim_Objβ¦ArrMapβ¦β¦gβ¦ :
lim_Obj cβ¦UObjβ¦ β¦βπβ lim_Obj c'β¦UObjβ¦"
and
"lim_Obj cβ¦UArrβ¦ ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F g β©Aββ©Cβ©F π =
lim_Obj c'β¦UArrβ¦ ββ©Nβ©Tβ©Cβ©F
ntcf_const (c' ββ©Cβ©F π) π (the_cf_rKe Ξ± π π lim_Objβ¦ArrMapβ¦β¦gβ¦)"
and
"β¦
f : lim_Obj cβ¦UObjβ¦ β¦βπβ lim_Obj c'β¦UObjβ¦;
lim_Obj cβ¦UArrβ¦ ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F g β©Aββ©Cβ©F π =
lim_Obj c'β¦UArrβ¦ ββ©Nβ©Tβ©Cβ©F ntcf_const (c' ββ©Cβ©F π) π f
β§ βΉ f = the_cf_rKe Ξ± π π lim_Objβ¦ArrMapβ¦β¦gβ¦"
proof-
interpret π: is_tm_functor Ξ± π
β π by (rule assms(1))
interpret π: is_functor Ξ± π
π π by (rule assms(2))
interpret u: is_cat_limit
Ξ± βΉc ββ©Cβ©F πβΊ π βΉπ ββ©Cβ©F c β©Oβ¨
β©Cβ©F πβΊ βΉlim_Obj cβ¦UObjβ¦βΊ βΉlim_Obj cβ¦UArrβ¦βΊ
by (rule assms(4))
interpret u': is_cat_limit
Ξ± βΉc' ββ©Cβ©F πβΊ π βΉπ ββ©Cβ©F c' β©Oβ¨
β©Cβ©F πβΊ βΉlim_Obj c'β¦UObjβ¦βΊ βΉlim_Obj c'β¦UArrβ¦βΊ
by (rule assms(5))
from assms(3) have c: "c ββ©β ββ¦Objβ¦" and c': "c' ββ©β ββ¦Objβ¦" by auto
note the_cf_rKe_ArrMap_app_impl' =
the_cf_rKe_ArrMap_app_impl[OF assms]
note the_f = theI'[OF the_cf_rKe_ArrMap_app_impl[OF assms]]
note the_f_is_arr = the_f[THEN conjunct1]
and the_f_commutes = the_f[THEN conjunct2]
from assms(3) the_f_is_arr show
"the_cf_rKe Ξ± π π lim_Objβ¦ArrMapβ¦β¦gβ¦ :
lim_Obj cβ¦UObjβ¦ β¦βπβ lim_Obj c'β¦UObjβ¦"
by (cs_concl cs_simp: the_cf_rKe_ArrMap_app' cs_intro: cat_cs_intros)
moreover from assms(3) the_f_commutes show
"lim_Obj cβ¦UArrβ¦ ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F g β©Aββ©Cβ©F π =
lim_Obj c'β¦UArrβ¦ ββ©Nβ©Tβ©Cβ©F
ntcf_const (c' ββ©Cβ©F π) π (the_cf_rKe Ξ± π π lim_Objβ¦ArrMapβ¦β¦gβ¦)"
by (cs_concl cs_simp: the_cf_rKe_ArrMap_app' cs_intro: cat_cs_intros)
ultimately show "f = the_cf_rKe Ξ± π π lim_Objβ¦ArrMapβ¦β¦gβ¦"
if "f : lim_Obj cβ¦UObjβ¦ β¦βπβ lim_Obj c'β¦UObjβ¦"
and "lim_Obj cβ¦UArrβ¦ ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F g β©Aββ©Cβ©F π =
lim_Obj c'β¦UArrβ¦ ββ©Nβ©Tβ©Cβ©F ntcf_const (c' ββ©Cβ©F π) π f"
by (metis that the_cf_rKe_ArrMap_app_impl')
qed
lemma the_cf_rKe_ArrMap_is_arr'[cat_Kan_cs_intros]:
assumes "π : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
and "π : π
β¦β¦β©CβΞ±β π"
and "g : c β¦βββ c'"
and "lim_Obj cβ¦UArrβ¦ :
lim_Obj cβ¦UObjβ¦ <β©Cβ©Fβ©.β©lβ©iβ©m π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π : c ββ©Cβ©F π β¦β¦β©CβΞ±β π"
and "lim_Obj c'β¦UArrβ¦ :
lim_Obj c'β¦UObjβ¦ <β©Cβ©Fβ©.β©lβ©iβ©m π ββ©Cβ©F c' β©Oβ¨
β©Cβ©F π : c' ββ©Cβ©F π β¦β¦β©CβΞ±β π"
and "a = lim_Obj cβ¦UObjβ¦"
and "b = lim_Obj c'β¦UObjβ¦"
shows "the_cf_rKe Ξ± π π lim_Objβ¦ArrMapβ¦β¦gβ¦ : a β¦βπβ b"
unfolding assms(6,7) by (rule the_cf_rKe_ArrMap_app[OF assms(1-5)])
lemma lim_Obj_the_cf_rKe_commute:
assumes "π : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
and "π : π
β¦β¦β©CβΞ±β π"
and "lim_Obj aβ¦UArrβ¦ :
lim_Obj aβ¦UObjβ¦ <β©Cβ©Fβ©.β©lβ©iβ©m π ββ©Cβ©F a β©Oβ¨
β©Cβ©F π : a ββ©Cβ©F π β¦β¦β©CβΞ±β π"
and "lim_Obj bβ¦UArrβ¦ :
lim_Obj bβ¦UObjβ¦ <β©Cβ©Fβ©.β©lβ©iβ©m π ββ©Cβ©F b β©Oβ¨
β©Cβ©F π : b ββ©Cβ©F π β¦β¦β©CβΞ±β π"
and "f : a β¦βββ b"
and "[a', b', f']β©β ββ©β b ββ©Cβ©F πβ¦Objβ¦"
shows
"lim_Obj aβ¦UArrβ¦β¦NTMapβ¦β¦a', b', f' ββ©Aβββ fβ¦β©β =
lim_Obj bβ¦UArrβ¦β¦NTMapβ¦β¦a', b', f'β¦β©β ββ©Aβπβ
the_cf_rKe Ξ± π π lim_Objβ¦ArrMapβ¦β¦fβ¦"
proof-
interpret π: is_tm_functor Ξ± π
β π by (rule assms(1))
interpret π: is_functor Ξ± π
π π by (rule assms(2))
note f = π.HomCod.cat_is_arrD[OF assms(5)]
interpret lim_a: is_cat_limit
Ξ± βΉa ββ©Cβ©F πβΊ π βΉπ ββ©Cβ©F a β©Oβ¨
β©Cβ©F πβΊ βΉlim_Obj aβ¦UObjβ¦βΊ βΉlim_Obj aβ¦UArrβ¦βΊ
by (rule assms(3))
interpret lim_b: is_cat_limit
Ξ± βΉb ββ©Cβ©F πβΊ π βΉπ ββ©Cβ©F b β©Oβ¨
β©Cβ©F πβΊ βΉlim_Obj bβ¦UObjβ¦βΊ βΉlim_Obj bβ¦UArrβ¦βΊ
by (rule assms(4))
note f_app = the_cf_rKe_ArrMap_app[
where lim_Obj=lim_Obj, OF assms(1,2,5,3,4)
]
from f_app(2) have lim_a_fπ_NTMap_app:
"(lim_Obj aβ¦UArrβ¦ ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F f β©Aββ©Cβ©F π)β¦NTMapβ¦β¦Aβ¦ =
(
lim_Obj bβ¦UArrβ¦ ββ©Nβ©Tβ©Cβ©F
ntcf_const (b ββ©Cβ©F π) π (the_cf_rKe Ξ± π π lim_Objβ¦ArrMapβ¦β¦fβ¦)
)β¦NTMapβ¦β¦Aβ¦"
if βΉA ββ©β b ββ©Cβ©F πβ¦Objβ¦βΊ for A
by simp
show
"lim_Obj aβ¦UArrβ¦β¦NTMapβ¦β¦a', b', f' ββ©Aβββ fβ¦β©β =
lim_Obj bβ¦UArrβ¦β¦NTMapβ¦β¦a', b', f'β¦β©β ββ©Aβπβ
the_cf_rKe Ξ± π π lim_Objβ¦ArrMapβ¦β¦fβ¦"
proof-
from assms(5,6) have a'_def: "a' = 0"
and b': "b' ββ©β π
β¦Objβ¦"
and f': "f' : b β¦βββ πβ¦ObjMapβ¦β¦b'β¦"
by auto
show
"lim_Obj aβ¦UArrβ¦β¦NTMapβ¦β¦a', b', f' ββ©Aβββ fβ¦β©β =
lim_Obj bβ¦UArrβ¦β¦NTMapβ¦β¦a', b', f'β¦β©β ββ©Aβπβ
the_cf_rKe Ξ± π π lim_Objβ¦ArrMapβ¦β¦fβ¦"
using lim_a_fπ_NTMap_app[OF assms(6)] f' assms(3,4,5,6)
unfolding a'_def
by
(
cs_prems
cs_simp: cat_cs_simps cat_comma_cs_simps cat_Kan_cs_simps
cs_intro:
cat_small_cs_intros
cat_cs_intros
cat_comma_cs_intros
cat_Kan_cs_intros
)
qed
qed
subsubsectionβΉNatural transformation: natural transformation mapβΊ
mk_VLambda the_ntcf_rKe_components(1)
|vsv the_ntcf_rKe_NTMap_vsv[cat_Kan_cs_intros]|
context
fixes Ξ± π π
β π π
assumes π: "π : π
β¦β¦β©CβΞ±β β"
and π: "π : π
β¦β¦β©CβΞ±β π"
begin
interpretation π: is_functor Ξ± π
β π by (rule π)
interpretation π: is_functor Ξ± π
π π by (rule π)
mk_VLambda the_ntcf_rKe_components'(1)[OF π π]
|vdomain the_ntcf_rKe_ObjMap_vdomain[cat_Kan_cs_simps]|
|app the_ntcf_rKe_ObjMap_impl_app[cat_Kan_cs_simps]|
end
subsubsectionβΉThe Kan extension is a Kan extensionβΊ
lemma the_cf_rKe_is_functor:
assumes "π : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
and "π : π
β¦β¦β©CβΞ±β π"
and "βc. c ββ©β ββ¦Objβ¦ βΉ lim_Obj cβ¦UArrβ¦ :
lim_Obj cβ¦UObjβ¦ <β©Cβ©Fβ©.β©lβ©iβ©m π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π : c ββ©Cβ©F π β¦β¦β©CβΞ±β π"
shows "the_cf_rKe Ξ± π π lim_Obj : β β¦β¦β©CβΞ±β π"
proof-
let ?UObj = βΉΞ»a. lim_Obj aβ¦UObjβ¦βΊ
let ?UArr = βΉΞ»a. lim_Obj aβ¦UArrβ¦βΊ
let ?const_comma = βΉΞ»a b. cf_const (a ββ©Cβ©F π) π (?UObj b)βΊ
let ?the_cf_rKe = βΉthe_cf_rKe Ξ± π π lim_ObjβΊ
interpret π: is_tm_functor Ξ± π
β π by (rule assms(1))
interpret π: is_functor Ξ± π
π π by (rule assms(2))
note [cat_lim_cs_intros] = is_cat_cone.cat_cone_obj
show ?thesis
proof(intro is_functorI')
show "vfsequence ?the_cf_rKe" unfolding the_cf_rKe_def by simp
show "vcard ?the_cf_rKe = 4β©β"
unfolding the_cf_rKe_def by (simp add: nat_omega_simps)
show "vsv (?the_cf_rKeβ¦ObjMapβ¦)" by (cs_concl cs_intro: cat_Kan_cs_intros)
moreover show "πβ©β (?the_cf_rKeβ¦ObjMapβ¦) = ββ¦Objβ¦"
by (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)
moreover show "ββ©β (?the_cf_rKeβ¦ObjMapβ¦) ββ©β πβ¦Objβ¦"
proof
(
intro the_cf_rKe_ObjMap_vrange;
(cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)?
)
fix c assume "c ββ©β ββ¦Objβ¦"
with assms(3)[OF this] show "?UObj c ββ©β πβ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_lim_cs_intros)
qed
ultimately have [cat_Kan_cs_intros]:
"?the_cf_rKeβ¦ObjMapβ¦β¦cβ¦ ββ©β πβ¦Objβ¦" if βΉc ββ©β ββ¦Objβ¦βΊ for c
by (metis that vsubsetE vsv.vsv_value)
show "?the_cf_rKeβ¦ArrMapβ¦β¦fβ¦ :
?the_cf_rKeβ¦ObjMapβ¦β¦aβ¦ β¦βπβ ?the_cf_rKeβ¦ObjMapβ¦β¦bβ¦"
if "f : a β¦βββ b" for a b f
using assms(2) that
by
(
cs_concl
cs_simp: cat_Kan_cs_simps
cs_intro:
assms(3) cat_small_cs_intros cat_cs_intros cat_Kan_cs_intros
)
then have [cat_Kan_cs_intros]: "?the_cf_rKeβ¦ArrMapβ¦β¦fβ¦ : A β¦βπβ B"
if "A = ?the_cf_rKeβ¦ObjMapβ¦β¦aβ¦"
and "B = ?the_cf_rKeβ¦ObjMapβ¦β¦bβ¦"
and "f : a β¦βββ b"
for A B a b f
by (simp add: that)
show
"?the_cf_rKeβ¦ArrMapβ¦β¦g ββ©Aβββ fβ¦ =
?the_cf_rKeβ¦ArrMapβ¦β¦gβ¦ ββ©Aβπβ ?the_cf_rKeβ¦ArrMapβ¦β¦fβ¦"
(is βΉ?the_cf_rKeβ¦ArrMapβ¦β¦g ββ©Aβββ fβ¦ = ?the_rKe_g ββ©Aβπβ ?the_rKe_fβΊ)
if g_is_arr: "g : b β¦βββ c" and f_is_arr: "f : a β¦βββ b" for b c g a f
proof-
let ?ntcf_const_c = βΉΞ»f. ntcf_const (c ββ©Cβ©F π) π fβΊ
note g = π.HomCod.cat_is_arrD[OF that(1)]
and f = π.HomCod.cat_is_arrD[OF that(2)]
note lim_a = assms(3)[OF f(2)]
and lim_b = assms(3)[OF g(2)]
and lim_c = assms(3)[OF g(3)]
from that have gf: "g ββ©Aβββ f : a β¦βββ c"
by (cs_concl cs_intro: cat_cs_intros)
interpret lim_a: is_cat_limit
Ξ± βΉa ββ©Cβ©F πβΊ π βΉπ ββ©Cβ©F a β©Oβ¨
β©Cβ©F πβΊ βΉ?UObj aβΊ βΉ?UArr aβΊ
by (rule lim_a)
interpret lim_c: is_cat_limit
Ξ± βΉc ββ©Cβ©F πβΊ π βΉπ ββ©Cβ©F c β©Oβ¨
β©Cβ©F πβΊ βΉ?UObj cβΊ βΉ?UArr cβΊ
by (rule lim_c)
show ?thesis
proof
(
rule sym,
rule the_cf_rKe_ArrMap_app(3)[OF assms(1,2) gf lim_a lim_c]
)
from assms(1,2) that lim_a lim_b lim_c show
"?the_rKe_g ββ©Aβπβ ?the_rKe_f : ?UObj a β¦βπβ ?UObj c"
by
(
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_Kan_cs_intros
)
show
"?UArr a ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F (g ββ©Aβββ f) β©Aββ©Cβ©F π =
?UArr c ββ©Nβ©Tβ©Cβ©F ?ntcf_const_c (?the_rKe_g ββ©Aβπβ ?the_rKe_f)"
(
is
βΉ
?UArr a ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F (g ββ©Aβββ f) β©Aββ©Cβ©F π =
?UArr c ββ©Nβ©Tβ©Cβ©F ?ntcf_const_c ?the_rKe_gf
βΊ
)
proof(rule ntcf_eqI)
from that show
"?UArr a ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F (g ββ©Aβββ f) β©Aββ©Cβ©F π :
cf_const (a ββ©Cβ©F π) π (?UObj a) ββ©Cβ©F (g ββ©Aβββ f) β©Aββ©Cβ©F π β¦β©Cβ©F
π ββ©Cβ©F a β©Oβ¨
β©Cβ©F π ββ©Cβ©F ((g ββ©Aβββ f) β©Aββ©Cβ©F π) :
c ββ©Cβ©F π β¦β¦β©CβΞ±β π"
by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
have [cat_comma_cs_simps]:
"?const_comma a a ββ©Cβ©F (g ββ©Aβββ f) β©Aββ©Cβ©F π = ?const_comma c a"
proof(rule cf_eqI)
from g_is_arr f_is_arr show
"?const_comma a a ββ©Cβ©F (g ββ©Aβββ f) β©Aββ©Cβ©F π : c ββ©Cβ©F π β¦β¦β©CβΞ±β π"
by
(
cs_concl
cs_simp: cat_comma_cs_simps cat_cs_simps
cs_intro:
cat_cs_intros cat_lim_cs_intros cat_comma_cs_intros
)
from g_is_arr f_is_arr show "?const_comma c a : c ββ©Cβ©F π β¦β¦β©CβΞ±β π"
by
(
cs_concl
cs_simp: cat_comma_cs_simps cat_cs_simps
cs_intro:
cat_cs_intros cat_lim_cs_intros cat_comma_cs_intros
)
from g_is_arr f_is_arr have ObjMap_dom_lhs:
"πβ©β ((?const_comma a a ββ©Cβ©F (g ββ©Aβββ f) β©Aββ©Cβ©F π)β¦ObjMapβ¦) =
c ββ©Cβ©F πβ¦Objβ¦"
by
(
cs_concl
cs_simp: cat_comma_cs_simps cat_cs_simps
cs_intro:
cat_comma_cs_intros cat_lim_cs_intros cat_cs_intros
)
from g_is_arr f_is_arr have ObjMap_dom_rhs:
"πβ©β (?const_comma c aβ¦ObjMapβ¦) = c ββ©Cβ©F πβ¦Objβ¦"
by (cs_concl cs_simp: cat_comma_cs_simps cat_cs_simps)
show
"(?const_comma a a ββ©Cβ©F (g ββ©Aβββ f) β©Aββ©Cβ©F π)β¦ObjMapβ¦ =
?const_comma c aβ¦ObjMapβ¦"
proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
from f_is_arr g_is_arr show
"vsv ((?const_comma a a ββ©Cβ©F (g ββ©Aβββ f) β©Aββ©Cβ©F π)β¦ObjMapβ¦)"
by
(
cs_concl
cs_simp: cat_comma_cs_simps cat_cs_simps
cs_intro:
cat_cs_intros cat_lim_cs_intros cat_comma_cs_intros
)
fix A assume prems: "A ββ©β c ββ©Cβ©F πβ¦Objβ¦"
with g_is_arr obtain b' f'
where A_def: "A = [0, b', f']β©β"
and b': "b' ββ©β π
β¦Objβ¦"
and f': "f' : c β¦βββ πβ¦ObjMapβ¦β¦b'β¦"
by auto
from prems b' f' g_is_arr f_is_arr show
"(?const_comma a a ββ©Cβ©F (g ββ©Aβββ f) β©Aββ©Cβ©F π)β¦ObjMapβ¦β¦Aβ¦ =
?const_comma c aβ¦ObjMapβ¦β¦Aβ¦"
unfolding A_def
by
(
cs_concl
cs_simp: cat_comma_cs_simps cat_cs_simps
cs_intro:
cat_cs_intros cat_lim_cs_intros cat_comma_cs_intros
)
qed (cs_concl cs_intro: cat_cs_intros)
from g_is_arr f_is_arr have ArrMap_dom_lhs:
"πβ©β ((?const_comma a a ββ©Cβ©F (g ββ©Aβββ f) β©Aββ©Cβ©F π)β¦ArrMapβ¦) =
c ββ©Cβ©F πβ¦Arrβ¦"
by
(
cs_concl
cs_simp: cat_comma_cs_simps cat_cs_simps
cs_intro:
cat_comma_cs_intros cat_lim_cs_intros cat_cs_intros
)
from g_is_arr f_is_arr have ArrMap_dom_rhs:
"πβ©β (?const_comma c aβ¦ArrMapβ¦) = c ββ©Cβ©F πβ¦Arrβ¦"
by (cs_concl cs_simp: cat_comma_cs_simps cat_cs_simps)
show
"(?const_comma a a ββ©Cβ©F (g ββ©Aβββ f) β©Aββ©Cβ©F π)β¦ArrMapβ¦ =
?const_comma c aβ¦ArrMapβ¦"
proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
from f_is_arr g_is_arr show
"vsv ((?const_comma a a ββ©Cβ©F (g ββ©Aβββ f) β©Aββ©Cβ©F π)β¦ArrMapβ¦)"
by
(
cs_concl
cs_simp: cat_comma_cs_simps cat_cs_simps
cs_intro:
cat_cs_intros cat_lim_cs_intros cat_comma_cs_intros
)
fix F assume "F ββ©β c ββ©Cβ©F πβ¦Arrβ¦"
then obtain A B where F: "F : A β¦βc ββ©Cβ©F πβ B"
unfolding cat_comma_cs_simps by (auto intro: is_arrI)
with g_is_arr obtain b' f' b'' f'' h'
where F_def: "F = [[0, b', f']β©β, [0, b'', f'']β©β, [0, h']β©β]β©β"
and A_def: "A = [0, b', f']β©β"
and B_def: "B = [0, b'', f'']β©β"
and h': "h' : b' β¦βπ
β b''"
and f': "f' : c β¦βββ πβ¦ObjMapβ¦β¦b'β¦"
and f'': "f'' : c β¦βββ πβ¦ObjMapβ¦β¦b''β¦"
and f''_def: "πβ¦ArrMapβ¦β¦h'β¦ ββ©Aβββ f' = f''"
by auto
from F f_is_arr g_is_arr g' h' f' f'' show
"(?const_comma a a ββ©Cβ©F (g ββ©Aβββ f) β©Aββ©Cβ©F π)β¦ArrMapβ¦β¦Fβ¦ =
?const_comma c aβ¦ArrMapβ¦β¦Fβ¦"
unfolding F_def A_def B_def
by
(
cs_concl
cs_intro:
cat_lim_cs_intros cat_cs_intros cat_comma_cs_intros
cs_simp:
cat_cs_simps cat_comma_cs_simps f''_def[symmetric]
)
qed (cs_concl cs_intro: cat_cs_intros)
qed simp_all
from that show
"?UArr c ββ©Nβ©Tβ©Cβ©F ?ntcf_const_c ?the_rKe_gf :
cf_const (a ββ©Cβ©F π) π (?UObj a) ββ©Cβ©F (g ββ©Aβββ f) β©Aββ©Cβ©F π β¦β©Cβ©F
π ββ©Cβ©F a β©Oβ¨
β©Cβ©F π ββ©Cβ©F ((g ββ©Aβββ f) β©Aββ©Cβ©F π) :
c ββ©Cβ©F π β¦β¦β©CβΞ±β π"
by
(
cs_concl
cs_simp: cat_Kan_cs_simps cat_comma_cs_simps cat_cs_simps
cs_intro: cat_comma_cs_intros cat_Kan_cs_intros cat_cs_intros
)
from that have dom_lhs:
"πβ©β ((?UArr a ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F (g ββ©Aβββ f) β©Aββ©Cβ©F π)β¦NTMapβ¦) = c ββ©Cβ©F πβ¦Objβ¦"
by
(
cs_concl
cs_intro: cat_cs_intros cat_comma_cs_intros
cs_simp: cat_cs_simps cat_comma_cs_simps
)
from that have dom_rhs:
"πβ©β ((?UArr c ββ©Nβ©Tβ©Cβ©F ?ntcf_const_c ?the_rKe_gf)β¦NTMapβ¦) =
c ββ©Cβ©F πβ¦Objβ¦"
by
(
cs_concl
cs_intro: cat_cs_intros cat_Kan_cs_intros cat_comma_cs_intros
cs_simp: cat_Kan_cs_simps cat_cs_simps cat_comma_cs_simps
)
show
"(?UArr a ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F (g ββ©Aβββ f) β©Aββ©Cβ©F π)β¦NTMapβ¦ =
(?UArr c ββ©Nβ©Tβ©Cβ©F ?ntcf_const_c ?the_rKe_gf)β¦NTMapβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix A assume prems: "A ββ©β c ββ©Cβ©F πβ¦Objβ¦"
with g_is_arr obtain b' f'
where A_def: "A = [0, b', f']β©β"
and b': "b' ββ©β π
β¦Objβ¦"
and f': "f' : c β¦βββ πβ¦ObjMapβ¦β¦b'β¦"
by auto
note π.HomCod.cat_Comp_assoc[cat_cs_simps del]
and π.HomCod.cat_Comp_assoc[cat_cs_simps del]
and category.cat_Comp_assoc[cat_cs_simps del]
note [symmetric, cat_cs_simps] =
lim_Obj_the_cf_rKe_commute[where lim_Obj=lim_Obj]
π.HomCod.cat_Comp_assoc
π.HomCod.cat_Comp_assoc
from assms(1,2) that prems lim_a lim_b lim_c b' f' show
"(?UArr a ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F (g ββ©Aβββ f) β©Aββ©Cβ©F π)β¦NTMapβ¦β¦Aβ¦ =
(?UArr c ββ©Nβ©Tβ©Cβ©F ?ntcf_const_c ?the_rKe_gf)β¦NTMapβ¦β¦Aβ¦"
unfolding A_def
by
(
cs_concl
cs_simp:
cat_cs_simps cat_Kan_cs_simps cat_comma_cs_simps
cs_intro:
cat_cs_intros cat_Kan_cs_intros cat_comma_cs_intros
)+
qed (cs_concl cs_simp: cs_intro: cat_cs_intros)+
qed simp_all
qed
qed
show "?the_cf_rKeβ¦ArrMapβ¦β¦ββ¦CIdβ¦β¦cβ¦β¦ = πβ¦CIdβ¦β¦?the_cf_rKeβ¦ObjMapβ¦β¦cβ¦β¦"
if "c ββ©β ββ¦Objβ¦" for c
proof-
let ?ntcf_const_c = βΉntcf_const (c ββ©Cβ©F π) π (πβ¦CIdβ¦β¦?UObj cβ¦)βΊ
note lim_c = assms(3)[OF that]
from that have CId_c: "ββ¦CIdβ¦β¦cβ¦ : c β¦βββ c"
by (cs_concl cs_intro: cat_cs_intros)
interpret lim_c: is_cat_limit
Ξ± βΉc ββ©Cβ©F πβΊ π βΉπ ββ©Cβ©F c β©Oβ¨
β©Cβ©F πβΊ βΉ?UObj cβΊ βΉ?UArr cβΊ
by (rule lim_c)
show ?thesis
proof
(
rule sym,
rule the_cf_rKe_ArrMap_app(3)[
where lim_Obj=lim_Obj, OF assms(1,2) CId_c lim_c lim_c
]
)
from that lim_c show
"πβ¦CIdβ¦β¦?the_cf_rKeβ¦ObjMapβ¦β¦cβ¦β¦ : ?UObj c β¦βπβ ?UObj c"
by
(
cs_concl
cs_simp: cat_Kan_cs_simps
cs_intro: cat_cs_intros cat_lim_cs_intros
)
have "?UArr c ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F (ββ¦CIdβ¦β¦cβ¦) β©Aββ©Cβ©F π = ?UArr c ββ©Nβ©Tβ©Cβ©F ?ntcf_const_c"
proof(rule ntcf_eqI)
from lim_c that show
"?UArr c ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F (ββ¦CIdβ¦β¦cβ¦) β©Aββ©Cβ©F π :
cf_const (c ββ©Cβ©F π) π (?UObj c) ββ©Cβ©F (ββ¦CIdβ¦β¦cβ¦) β©Aββ©Cβ©F π β¦β©Cβ©F
π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π ββ©Cβ©F (ββ¦CIdβ¦β¦cβ¦) β©Aββ©Cβ©F π :
c ββ©Cβ©F π β¦β¦β©CβΞ±β π"
by (cs_concl cs_simp: cs_intro: cat_cs_intros cat_comma_cs_intros)
from lim_c that show
"?UArr c ββ©Nβ©Tβ©Cβ©F ?ntcf_const_c :
cf_const (c ββ©Cβ©F π) π (?UObj c) ββ©Cβ©F (ββ¦CIdβ¦β¦cβ¦) β©Aββ©Cβ©F π β¦β©Cβ©F
π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π ββ©Cβ©F (ββ¦CIdβ¦β¦cβ¦) β©Aββ©Cβ©F π :
c ββ©Cβ©F π β¦β¦β©CβΞ±β π"
by
(
cs_concl
cs_intro: cat_cs_intros cat_lim_cs_intros
cs_simp: π.cf_cf_arr_comma_CId cat_cs_simps
)
from that have dom_lhs:
"πβ©β ((?UArr c ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F (ββ¦CIdβ¦β¦cβ¦) β©Aββ©Cβ©F π)β¦NTMapβ¦) = c ββ©Cβ©F πβ¦Objβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_comma_cs_intros
)
from that have dom_rhs:
"πβ©β ((?UArr c ββ©Nβ©Tβ©Cβ©F ?ntcf_const_c)β¦NTMapβ¦) = c ββ©Cβ©F πβ¦Objβ¦"
by
(
cs_concl
cs_intro: cat_lim_cs_intros cat_cs_intros
cs_simp: cat_cs_simps
)
show
"(?UArr c ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F (ββ¦CIdβ¦β¦cβ¦) β©Aββ©Cβ©F π)β¦NTMapβ¦ =
(?UArr c ββ©Nβ©Tβ©Cβ©F ?ntcf_const_c)β¦NTMapβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix A assume prems: "A ββ©β c ββ©Cβ©F πβ¦Objβ¦"
with that obtain b f
where A_def: "A = [0, b, f]β©β"
and b: "b ββ©β π
β¦Objβ¦"
and f: "f : c β¦βββ πβ¦ObjMapβ¦β¦bβ¦"
by auto
from that prems f have
"?UArr cβ¦NTMapβ¦β¦0, b, fβ¦β©β : ?UObj c β¦βπβ πβ¦ObjMapβ¦β¦bβ¦"
unfolding A_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_comma_cs_simps
cs_intro: cat_comma_cs_intros cat_cs_intros
)
from that prems f show
"(?UArr c ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F (ββ¦CIdβ¦β¦cβ¦) β©Aββ©Cβ©F π)β¦NTMapβ¦β¦Aβ¦ =
(?UArr c ββ©Nβ©Tβ©Cβ©F ?ntcf_const_c)β¦NTMapβ¦β¦Aβ¦"
unfolding A_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_comma_cs_simps
cs_intro:
cat_lim_cs_intros cat_comma_cs_intros cat_cs_intros
)
qed (cs_concl cs_intro: cat_cs_intros)
qed simp_all
with that show
"?UArr c ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F (ββ¦CIdβ¦β¦cβ¦) β©Aββ©Cβ©F π =
?UArr c ββ©Nβ©Tβ©Cβ©F ntcf_const (c ββ©Cβ©F π) π (πβ¦CIdβ¦β¦?the_cf_rKeβ¦ObjMapβ¦β¦cβ¦β¦)"
by (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)
qed
qed
qed
(
cs_concl
cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros cat_Kan_cs_intros
)+
qed
lemma the_ntcf_rKe_is_ntcf:
assumes "π : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
and "π : π
β¦β¦β©CβΞ±β π"
and "βc. c ββ©β ββ¦Objβ¦ βΉ lim_Obj cβ¦UArrβ¦ :
lim_Obj cβ¦UObjβ¦ <β©Cβ©Fβ©.β©lβ©iβ©m π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π : c ββ©Cβ©F π β¦β¦β©CβΞ±β π"
shows "the_ntcf_rKe Ξ± π π lim_Obj :
the_cf_rKe Ξ± π π lim_Obj ββ©Cβ©F π β¦β©Cβ©F π : π
β¦β¦β©CβΞ±β π"
proof-
let ?UObj = βΉΞ»a. lim_Obj aβ¦UObjβ¦βΊ
let ?UArr = βΉΞ»a. lim_Obj aβ¦UArrβ¦βΊ
let ?const_comma = βΉΞ»a b. cf_const (a ββ©Cβ©F π) π (?UObj b)βΊ
let ?the_cf_rKe = βΉthe_cf_rKe Ξ± π π lim_ObjβΊ
let ?the_ntcf_rKe = βΉthe_ntcf_rKe Ξ± π π lim_ObjβΊ
interpret π: is_tm_functor Ξ± π
β π by (rule assms(1))
interpret π: is_functor Ξ± π
π π by (rule assms(2))
interpret cf_rKe: is_functor Ξ± β π βΉ?the_cf_rKeβΊ
by (rule the_cf_rKe_is_functor[OF assms, simplified])
show ?thesis
proof(rule is_ntcfI')
show "vfsequence ?the_ntcf_rKe" unfolding the_ntcf_rKe_def by simp
show "vcard ?the_ntcf_rKe = 5β©β"
unfolding the_ntcf_rKe_def by (simp add: nat_omega_simps)
show "?the_ntcf_rKeβ¦NTMapβ¦β¦bβ¦ :
(?the_cf_rKe ββ©Cβ©F π)β¦ObjMapβ¦β¦bβ¦ β¦βπβ πβ¦ObjMapβ¦β¦bβ¦"
if "b ββ©β π
β¦Objβ¦" for b
proof-
let ?πb = βΉπβ¦ObjMapβ¦β¦bβ¦βΊ
from that have πb: "πβ¦ObjMapβ¦β¦bβ¦ ββ©β ββ¦Objβ¦"
by (cs_concl cs_intro: cat_cs_intros)
note lim_πb = assms(3)[OF πb]
interpret lim_πb: is_cat_limit
Ξ± βΉ?πb ββ©Cβ©F πβΊ π βΉπ ββ©Cβ©F ?πb β©Oβ¨
β©Cβ©F πβΊ βΉ?UObj ?πbβΊ βΉ?UArr ?πbβΊ
by (rule lim_πb)
from that lim_πb show ?thesis
by
(
cs_concl
cs_simp: cat_cs_simps cat_comma_cs_simps cat_Kan_cs_simps
cs_intro: cat_cs_intros cat_comma_cs_intros cat_Kan_cs_intros
)+
qed
show
"?the_ntcf_rKeβ¦NTMapβ¦β¦bβ¦ ββ©Aβπβ (?the_cf_rKe ββ©Cβ©F π)β¦ArrMapβ¦β¦fβ¦ =
πβ¦ArrMapβ¦β¦fβ¦ ββ©Aβπβ ?the_ntcf_rKeβ¦NTMapβ¦β¦aβ¦"
if "f : a β¦βπ
β b" for a b f
proof-
let ?πa = βΉπβ¦ObjMapβ¦β¦aβ¦βΊ and ?πb = βΉπβ¦ObjMapβ¦β¦bβ¦βΊ and ?πf = βΉπβ¦ArrMapβ¦β¦fβ¦βΊ
from that have πa: "?πa ββ©β ββ¦Objβ¦"
and πb: "?πb ββ©β ββ¦Objβ¦"
and πf: "?πf : ?πa β¦βββ ?πb"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
note lim_πa = assms(3)[OF πa]
and lim_πb = assms(3)[OF πb]
from that have z_b_πb: "[0, b, ββ¦CIdβ¦β¦?πbβ¦]β©β ββ©β ?πb ββ©Cβ©F πβ¦Objβ¦"
by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
from
lim_Obj_the_cf_rKe_commute[
OF assms(1,2) lim_πa lim_πb πf z_b_πb, symmetric
]
that
have [cat_Kan_cs_simps]:
"?UArr ?πbβ¦NTMapβ¦β¦0, b, ββ¦CIdβ¦β¦?πbβ¦β¦β©β ββ©Aβπβ ?the_cf_rKeβ¦ArrMapβ¦β¦?πfβ¦ =
?UArr ?πaβ¦NTMapβ¦β¦0, b, ?πfβ¦β©β"
by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
interpret lim_πa: is_cat_limit
Ξ± βΉ?πa ββ©Cβ©F πβΊ π βΉπ ββ©Cβ©F ?πa β©Oβ¨
β©Cβ©F πβΊ βΉ?UObj ?πaβΊ βΉ?UArr ?πaβΊ
by (rule lim_πa)
interpret lim_πb: is_cat_limit
Ξ± βΉ?πb ββ©Cβ©F πβΊ π βΉπ ββ©Cβ©F ?πb β©Oβ¨
β©Cβ©F πβΊ βΉ?UObj ?πbβΊ βΉ?UArr ?πbβΊ
by (rule lim_πb)
from that have
"[[0, a, ββ¦CIdβ¦β¦?πaβ¦]β©β, [0, b, ?πf]β©β, [0, f]β©β]β©β :
[0, a, ββ¦CIdβ¦β¦?πaβ¦]β©β β¦β(?πa) ββ©Cβ©F πβ [0, b, ?πf]β©β"
by
(
cs_concl
cs_simp: cat_cs_simps cat_comma_cs_simps
cs_intro: cat_cs_intros cat_comma_cs_intros
)
from lim_πa.ntcf_Comp_commute[OF this, symmetric] that
have [cat_Kan_cs_simps]:
"πβ¦ArrMapβ¦β¦fβ¦ ββ©Aβπβ ?UArr (?πa)β¦NTMapβ¦ β¦0, a, ββ¦CIdβ¦β¦?πaβ¦β¦β©β =
?UArr ?πaβ¦NTMapβ¦β¦0, b, ?πfβ¦β©β"
by
(
cs_prems
cs_simp: cat_cs_simps cat_comma_cs_simps
cs_intro: cat_cs_intros cat_comma_cs_intros π΅.cat_1_is_arrI
)
from that show ?thesis
by
(
cs_concl
cs_simp: cat_cs_simps cat_Kan_cs_simps cs_intro: cat_cs_intros
)
qed
qed
(
cs_concl
cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros cat_Kan_cs_intros
)+
qed
lemma the_ntcf_rKe_is_cat_rKe:
assumes "π : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
and "π : π
β¦β¦β©CβΞ±β π"
and "βc. c ββ©β ββ¦Objβ¦ βΉ lim_Obj cβ¦UArrβ¦ :
lim_Obj cβ¦UObjβ¦ <β©Cβ©Fβ©.β©lβ©iβ©m π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π : c ββ©Cβ©F π β¦β¦β©CβΞ±β π"
shows "the_ntcf_rKe Ξ± π π lim_Obj :
the_cf_rKe Ξ± π π lim_Obj ββ©Cβ©F π β¦β©Cβ©Fβ©.β©rβ©Kβ©eβΞ±β π : π
β¦β©C β β¦β©C π"
proof-
let ?UObj = βΉΞ»a. lim_Obj aβ¦UObjβ¦βΊ
let ?UArr = βΉΞ»a. lim_Obj aβ¦UArrβ¦βΊ
let ?the_cf_rKe = βΉthe_cf_rKe Ξ± π π lim_ObjβΊ
let ?the_ntcf_rKe = βΉthe_ntcf_rKe Ξ± π π lim_ObjβΊ
interpret π: is_tm_functor Ξ± π
β π by (rule assms(1))
interpret π: is_functor Ξ± π
π π by (rule assms(2))
interpret cf_rKe: is_functor Ξ± β π ?the_cf_rKe
by (rule the_cf_rKe_is_functor[OF assms, simplified])
interpret ntcf_rKe: is_ntcf Ξ± π
π βΉ?the_cf_rKe ββ©Cβ©F πβΊ π ?the_ntcf_rKe
by (intro the_ntcf_rKe_is_ntcf assms(3))
(cs_concl cs_intro: cat_cs_intros cat_small_cs_intros)+
show ?thesis
proof(rule is_cat_rKeI')
fix π Ξ΅ assume prems:
"π : β β¦β¦β©CβΞ±β π" "Ξ΅ : π ββ©Cβ©F π β¦β©Cβ©F π : π
β¦β¦β©CβΞ±β π"
interpret π: is_functor Ξ± β π π by (rule prems(1))
interpret Ξ΅: is_ntcf Ξ± π
π βΉπ ββ©Cβ©F πβΊ π Ξ΅ by (rule prems(2))
define Ξ΅' where "Ξ΅' c =
[
(Ξ»Aββ©βc ββ©Cβ©F πβ¦Objβ¦. Ξ΅β¦NTMapβ¦β¦Aβ¦1β©ββ¦β¦ ββ©Aβπβ πβ¦ArrMapβ¦β¦Aβ¦2β©ββ¦β¦),
cf_const (c ββ©Cβ©F π) π (πβ¦ObjMapβ¦β¦cβ¦),
π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π,
c ββ©Cβ©F π,
π
]β©β"
for c
have Ξ΅'_components:
"Ξ΅' cβ¦NTMapβ¦ = (Ξ»Aββ©βc ββ©Cβ©F πβ¦Objβ¦. Ξ΅β¦NTMapβ¦β¦Aβ¦1β©ββ¦β¦ ββ©Aβπβ πβ¦ArrMapβ¦β¦Aβ¦2β©ββ¦β¦)"
"Ξ΅' cβ¦NTDomβ¦ = cf_const (c ββ©Cβ©F π) π (πβ¦ObjMapβ¦β¦cβ¦)"
"Ξ΅' cβ¦NTCodβ¦ = π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π"
"Ξ΅' cβ¦NTDGDomβ¦ = c ββ©Cβ©F π"
"Ξ΅' cβ¦NTDGCodβ¦ = π"
for c
unfolding Ξ΅'_def nt_field_simps by (simp_all add: nat_omega_simps)
note [cat_Kan_cs_simps] = Ξ΅'_components(2-5)
have [cat_Kan_cs_simps]: "Ξ΅' cβ¦NTMapβ¦β¦Aβ¦ = Ξ΅β¦NTMapβ¦β¦bβ¦ ββ©Aβπβ πβ¦ArrMapβ¦β¦fβ¦"
if "A = [a, b, f]β©β" and "[a, b, f]β©β ββ©β c ββ©Cβ©F πβ¦Objβ¦" for A a b c f
using that unfolding Ξ΅'_components by (auto simp: nat_omega_simps)
have Ξ΅': "Ξ΅' c : πβ¦ObjMapβ¦β¦cβ¦ <β©Cβ©Fβ©.β©cβ©oβ©nβ©e π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π : c ββ©Cβ©F π β¦β¦β©CβΞ±β π"
and Ξ΅'_unique: "β!f'.
f' : πβ¦ObjMapβ¦β¦cβ¦ β¦βπβ ?UObj c β§
Ξ΅' c = ?UArr c ββ©Nβ©Tβ©Cβ©F ntcf_const (c ββ©Cβ©F π) π f'"
if c: "c ββ©β ββ¦Objβ¦" for c
proof-
from that have "?the_cf_rKeβ¦ObjMapβ¦β¦cβ¦ = ?UObj c"
by (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)
interpret lim_c: is_cat_limit
Ξ± βΉc ββ©Cβ©F πβΊ π βΉπ ββ©Cβ©F c β©Oβ¨
β©Cβ©F πβΊ βΉ?UObj cβΊ βΉ?UArr cβΊ
by (rule assms(3)[OF that])
show "Ξ΅' c : πβ¦ObjMapβ¦β¦cβ¦ <β©Cβ©Fβ©.β©cβ©oβ©nβ©e π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π : c ββ©Cβ©F π β¦β¦β©CβΞ±β π"
proof(intro is_cat_coneI is_tm_ntcfI' is_ntcfI')
show "vfsequence (Ξ΅' c)" unfolding Ξ΅'_def by simp
show "vcard (Ξ΅' c) = 5β©β" unfolding Ξ΅'_def by (simp add: nat_omega_simps)
show "vsv (Ξ΅' cβ¦NTMapβ¦)" unfolding Ξ΅'_components by simp
show "πβ©β (Ξ΅' cβ¦NTMapβ¦) = c ββ©Cβ©F πβ¦Objβ¦" unfolding Ξ΅'_components by simp
show "Ξ΅' cβ¦NTMapβ¦β¦Aβ¦ :
cf_const (c ββ©Cβ©F π) π (πβ¦ObjMapβ¦β¦cβ¦)β¦ObjMapβ¦β¦Aβ¦ β¦βπβ
(π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π)β¦ObjMapβ¦β¦Aβ¦"
if "A ββ©β c ββ©Cβ©F πβ¦Objβ¦" for A
proof-
from that prems c obtain b f
where A_def: "A = [0, b, f]β©β"
and b: "b ββ©β π
β¦Objβ¦"
and f: "f : c β¦βββ πβ¦ObjMapβ¦β¦bβ¦"
by auto
from that prems f c that b f show ?thesis
unfolding A_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_Kan_cs_simps cat_comma_cs_simps
cs_intro: cat_cs_intros cat_comma_cs_intros
)
qed
show
"Ξ΅' cβ¦NTMapβ¦β¦Bβ¦ ββ©Aβπβ cf_const (c ββ©Cβ©F π) π (πβ¦ObjMapβ¦β¦cβ¦)β¦ArrMapβ¦β¦Fβ¦ =
(π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π)β¦ArrMapβ¦β¦Fβ¦ ββ©Aβπβ Ξ΅' cβ¦NTMapβ¦β¦Aβ¦"
if "F : A β¦βc ββ©Cβ©F πβ B" for A B F
proof-
from that c
obtain b f b' f' k
where F_def: "F = [[0, b, f]β©β, [0, b', f']β©β, [0, k]β©β]β©β"
and A_def: "A = [0, b, f]β©β"
and B_def: "B = [0, b', f']β©β"
and k: "k : b β¦βπ
β b'"
and f: "f : c β¦βββ πβ¦ObjMapβ¦β¦bβ¦"
and f': "f' : c β¦βββ πβ¦ObjMapβ¦β¦b'β¦"
and f'_def: "πβ¦ArrMapβ¦β¦kβ¦ ββ©Aβββ f = f'"
by auto
from c that k f f' show ?thesis
unfolding F_def A_def B_def
by
(
cs_concl
cs_simp:
cat_cs_simps
cat_comma_cs_simps
cat_Kan_cs_simps
Ξ΅.ntcf_Comp_commute''
f'_def[symmetric]
cs_intro: cat_cs_intros cat_comma_cs_intros
)
qed
qed
(
use c that in
βΉ
cs_concl
cs_simp: cat_Kan_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros
βΊ
)+
from is_cat_limit.cat_lim_unique_cone[OF assms(3)[OF that] this] show
"β!f'.
f' : πβ¦ObjMapβ¦β¦cβ¦ β¦βπβ ?UObj c β§
Ξ΅' c = ?UArr c ββ©Nβ©Tβ©Cβ©F ntcf_const (c ββ©Cβ©F π) π f'"
by simp
qed
define Ο :: V where
"Ο =
[
(
Ξ»cββ©βββ¦Objβ¦. THE f.
f : πβ¦ObjMapβ¦β¦cβ¦ β¦βπβ ?UObj c β§
Ξ΅' c = ?UArr c ββ©Nβ©Tβ©Cβ©F ntcf_const (c ββ©Cβ©F π) π f
),
π,
?the_cf_rKe,
β,
π
]β©β"
have Ο_components:
"Οβ¦NTMapβ¦ =
(
Ξ»cββ©βββ¦Objβ¦. THE f.
f : πβ¦ObjMapβ¦β¦cβ¦ β¦βπβ ?UObj c β§
Ξ΅' c = ?UArr c ββ©Nβ©Tβ©Cβ©F ntcf_const (c ββ©Cβ©F π) π f
)"
"Οβ¦NTDomβ¦ = π"
"Οβ¦NTCodβ¦ = ?the_cf_rKe"
"Οβ¦NTDGDomβ¦ = β"
"Οβ¦NTDGCodβ¦ = π"
unfolding Ο_def nt_field_simps by (simp_all add: nat_omega_simps)
note [cat_Kan_cs_simps] = Ο_components(2-5)
have Ο_NTMap_app_def: "Οβ¦NTMapβ¦β¦cβ¦ =
(
THE f.
f : πβ¦ObjMapβ¦β¦cβ¦ β¦βπβ ?UObj c β§
Ξ΅' c = ?UArr c ββ©Nβ©Tβ©Cβ©F ntcf_const (c ββ©Cβ©F π) π f
)"
if "c ββ©β ββ¦Objβ¦" for c
using that unfolding Ο_components by simp
have Ο_NTMap_app_is_arr: "Οβ¦NTMapβ¦β¦cβ¦ : πβ¦ObjMapβ¦β¦cβ¦ β¦βπβ ?UObj c"
and Ξ΅'_Ο_commute:
"Ξ΅' c = ?UArr c ββ©Nβ©Tβ©Cβ©F ntcf_const (c ββ©Cβ©F π) π (Οβ¦NTMapβ¦β¦cβ¦)"
and Ο_NTMap_app_unique:
"β¦
f : πβ¦ObjMapβ¦β¦cβ¦ β¦βπβ ?UObj c;
Ξ΅' c = ?UArr c ββ©Nβ©Tβ©Cβ©F ntcf_const (c ββ©Cβ©F π) π f
β§ βΉ f = Οβ¦NTMapβ¦β¦cβ¦"
if c: "c ββ©β ββ¦Objβ¦" for c f
proof-
have
"Οβ¦NTMapβ¦β¦cβ¦ : πβ¦ObjMapβ¦β¦cβ¦ β¦βπβ ?UObj c β§
Ξ΅' c = ?UArr c ββ©Nβ©Tβ©Cβ©F ntcf_const (c ββ©Cβ©F π) π (Οβ¦NTMapβ¦β¦cβ¦)"
by
(
cs_concl
cs_simp: cat_Kan_cs_simps Ο_NTMap_app_def
cs_intro: theI' Ξ΅'_unique that
)
then show "Οβ¦NTMapβ¦β¦cβ¦ : πβ¦ObjMapβ¦β¦cβ¦ β¦βπβ ?UObj c"
and "Ξ΅' c = ?UArr c ββ©Nβ©Tβ©Cβ©F ntcf_const (c ββ©Cβ©F π) π (Οβ¦NTMapβ¦β¦cβ¦)"
by simp_all
with c Ξ΅'_unique[OF c] show "f = Οβ¦NTMapβ¦β¦cβ¦"
if "f : πβ¦ObjMapβ¦β¦cβ¦ β¦βπβ ?UObj c"
and "Ξ΅' c = ?UArr c ββ©Nβ©Tβ©Cβ©F ntcf_const (c ββ©Cβ©F π) π f"
using that by metis
qed
have Ο_NTMap_app_is_arr'[cat_Kan_cs_intros]: "Οβ¦NTMapβ¦β¦cβ¦ : a β¦βπ'β b"
if "c ββ©β ββ¦Objβ¦"
and "a = πβ¦ObjMapβ¦β¦cβ¦"
and "b = ?UObj c"
and "π' = π"
for π' a b c
by (simp add: that Ο_NTMap_app_is_arr)
have Ξ΅'_NTMap_app_def:
"Ξ΅' cβ¦NTMapβ¦β¦Aβ¦ =
(?UArr c ββ©Nβ©Tβ©Cβ©F ntcf_const (c ββ©Cβ©F π) π (Οβ¦NTMapβ¦β¦cβ¦))β¦NTMapβ¦β¦Aβ¦"
if "A ββ©β c ββ©Cβ©F πβ¦Objβ¦" and "c ββ©β ββ¦Objβ¦" for A c
using Ξ΅'_Ο_commute[OF that(2)] by simp
have Ξ΅b_πf:
"Ξ΅β¦NTMapβ¦β¦bβ¦ ββ©Aβπβ πβ¦ArrMapβ¦β¦fβ¦ =
?UArr cβ¦NTMapβ¦β¦a, b, fβ¦β©β ββ©Aβπβ Οβ¦NTMapβ¦β¦cβ¦"
if "A = [a, b, f]β©β" and "A ββ©β c ββ©Cβ©F πβ¦Objβ¦" and "c ββ©β ββ¦Objβ¦"
for A a b c f
proof-
interpret lim_c: is_cat_limit
Ξ± βΉc ββ©Cβ©F πβΊ π βΉπ ββ©Cβ©F c β©Oβ¨
β©Cβ©F πβΊ βΉ?UObj cβΊ βΉ?UArr cβΊ
by (rule assms(3)[OF that(3)])
from that have b: "b ββ©β π
β¦Objβ¦" and f: "f : c β¦βββ πβ¦ObjMapβ¦β¦bβ¦"
by blast+
show
"Ξ΅β¦NTMapβ¦β¦bβ¦ ββ©Aβπβ πβ¦ArrMapβ¦β¦fβ¦ =
?UArr cβ¦NTMapβ¦β¦a, b, fβ¦β©β ββ©Aβπβ Οβ¦NTMapβ¦β¦cβ¦"
using Ξ΅'_NTMap_app_def[OF that(2,3)] that(2,3)
unfolding that(1)
by
(
cs_prems
cs_simp: cat_cs_simps cat_Kan_cs_simps
cs_intro: cat_cs_intros cat_Kan_cs_intros
)
qed
show "β!Ο.
Ο : π β¦β©Cβ©F ?the_cf_rKe : β β¦β¦β©CβΞ±β π β§
Ξ΅ = ?the_ntcf_rKe ββ©Nβ©Tβ©Cβ©F (Ο ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π)"
proof(intro ex1I[where a=Ο] conjI; (elim conjE)?)
define Ο where "Ο a b f =
[
(
Ξ»Fββ©βb ββ©Cβ©F πβ¦Objβ¦.
?UArr bβ¦NTMapβ¦β¦Fβ¦ ββ©Aβπβ Οβ¦NTMapβ¦β¦bβ¦ ββ©Aβπβ πβ¦ArrMapβ¦β¦fβ¦
),
cf_const (b ββ©Cβ©F π) π (πβ¦ObjMapβ¦β¦aβ¦),
π ββ©Cβ©F b β©Oβ¨
β©Cβ©F π,
b ββ©Cβ©F π,
π
]β©β"
for a b f
have Ο_components:
"Ο a b fβ¦NTMapβ¦ =
(
Ξ»Fββ©βb ββ©Cβ©F πβ¦Objβ¦.
?UArr bβ¦NTMapβ¦β¦Fβ¦ ββ©Aβπβ Οβ¦NTMapβ¦β¦bβ¦ ββ©Aβπβ πβ¦ArrMapβ¦β¦fβ¦
)"
"Ο a b fβ¦NTDomβ¦ = cf_const (b ββ©Cβ©F π) π (πβ¦ObjMapβ¦β¦aβ¦)"
"Ο a b fβ¦NTCodβ¦ = π ββ©Cβ©F b β©Oβ¨
β©Cβ©F π"
"Ο a b fβ¦NTDGDomβ¦ = b ββ©Cβ©F π"
"Ο a b fβ¦NTDGCodβ¦ = π"
for a b f
unfolding Ο_def nt_field_simps by (simp_all add: nat_omega_simps)
note [cat_Kan_cs_simps] = Ο_components(2-5)
have Ο_NTMap_app[cat_Kan_cs_simps]:
"Ο a b fβ¦NTMapβ¦β¦Fβ¦ =
?UArr bβ¦NTMapβ¦β¦Fβ¦ ββ©Aβπβ Οβ¦NTMapβ¦β¦bβ¦ ββ©Aβπβ πβ¦ArrMapβ¦β¦fβ¦"
if "F ββ©β b ββ©Cβ©F πβ¦Objβ¦" for a b f F
using that unfolding Ο_components by auto
have Ο: "Ο a b f :
πβ¦ObjMapβ¦β¦aβ¦ <β©Cβ©Fβ©.β©cβ©oβ©nβ©e π ββ©Cβ©F b β©Oβ¨
β©Cβ©F π : b ββ©Cβ©F π β¦β¦β©CβΞ±β π"
if f_is_arr: "f : a β¦βββ b" for a b f
proof-
note f = π.HomCod.cat_is_arrD[OF that]
note lim_a = assms(3)[OF f(2)] and lim_b = assms(3)[OF f(3)]
interpret lim_b: is_cat_limit
Ξ± βΉb ββ©Cβ©F πβΊ π βΉπ ββ©Cβ©F b β©Oβ¨
β©Cβ©F πβΊ βΉ?UObj bβΊ βΉ?UArr bβΊ
by (rule lim_b)
from f have a: "a ββ©β ββ¦Objβ¦" and b: "b ββ©β ββ¦Objβ¦" by auto
show ?thesis
proof(intro is_cat_coneI is_tm_ntcfI' is_ntcfI')
show "vfsequence (Ο a b f)" unfolding Ο_def by simp
show "vcard (Ο a b f) = 5β©β"
unfolding Ο_def by (simp add: nat_omega_simps)
show "vsv (Ο a b fβ¦NTMapβ¦)" unfolding Ο_components by auto
show "πβ©β (Ο a b fβ¦NTMapβ¦) = b ββ©Cβ©F πβ¦Objβ¦" by (auto simp: Ο_components)
show "Ο a b fβ¦NTMapβ¦β¦Aβ¦ :
cf_const (b ββ©Cβ©F π) π (πβ¦ObjMapβ¦β¦aβ¦)β¦ObjMapβ¦β¦Aβ¦ β¦βπβ
(π ββ©Cβ©F b β©Oβ¨
β©Cβ©F π)β¦ObjMapβ¦β¦Aβ¦"
if "A ββ©β b ββ©Cβ©F πβ¦Objβ¦" for A
proof-
from that f_is_arr obtain b' f'
where A_def: "A = [0, b', f']β©β"
and b': "b' ββ©β π
β¦Objβ¦"
and f': "f' : b β¦βββ πβ¦ObjMapβ¦β¦b'β¦"
by auto
from f_is_arr that b' f' a b show ?thesis
unfolding A_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_comma_cs_simps cat_Kan_cs_simps
cs_intro: cat_cs_intros cat_comma_cs_intros cat_Kan_cs_intros
)
qed
show
"Ο a b fβ¦NTMapβ¦β¦Bβ¦ ββ©Aβπβ
cf_const (b ββ©Cβ©F π) π (πβ¦ObjMapβ¦β¦aβ¦)β¦ArrMapβ¦β¦Fβ¦ =
(π ββ©Cβ©F b β©Oβ¨
β©Cβ©F π)β¦ArrMapβ¦β¦Fβ¦ ββ©Aβπβ Ο a b fβ¦NTMapβ¦β¦Aβ¦"
if "F : A β¦βb ββ©Cβ©F πβ B" for A B F
proof-
from that have F: "F : A β¦βb ββ©Cβ©F πβ B"
by (auto intro: is_arrI)
with f_is_arr obtain b' f' b'' f'' h'
where F_def: "F = [[0, b', f']β©β, [0, b'', f'']β©β, [0, h']β©β]β©β"
and A_def: "A = [0, b', f']β©β"
and B_def: "B = [0, b'', f'']β©β"
and h': "h' : b' β¦βπ
β b''"
and f': "f' : b β¦βββ πβ¦ObjMapβ¦β¦b'β¦"
and f'': "f'' : b β¦βββ πβ¦ObjMapβ¦β¦b''β¦"
and f''_def: "πβ¦ArrMapβ¦β¦h'β¦ ββ©Aβββ f' = f''"
by auto
from
lim_b.ntcf_Comp_commute[OF that]
that f_is_arr g' h' f' f''
have [cat_Kan_cs_simps]:
"?UArr bβ¦NTMapβ¦β¦0, b'', πβ¦ArrMapβ¦β¦h'β¦ ββ©Aβββ f'β¦β©β =
πβ¦ArrMapβ¦β¦h'β¦ ββ©Aβπβ ?UArr bβ¦NTMapβ¦β¦0, b', f'β¦β©β"
unfolding F_def A_def B_def
by
(
cs_prems
cs_simp:
cat_cs_simps cat_comma_cs_simps f''_def[symmetric]
cs_intro: cat_cs_intros cat_comma_cs_intros
)
from f_is_arr that g' h' f' f'' show ?thesis
unfolding F_def A_def B_def
by
(
cs_concl
cs_simp:
cat_cs_simps
cat_Kan_cs_simps
cat_comma_cs_simps
f''_def[symmetric]
cs_intro:
cat_cs_intros cat_Kan_cs_intros cat_comma_cs_intros
)+
qed
qed
(
use that f_is_arr in
βΉ
cs_concl
cs_simp: cat_cs_simps cat_Kan_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros
βΊ
)+
qed
show Ο: "Ο : π β¦β©Cβ©F ?the_cf_rKe : β β¦β¦β©CβΞ±β π"
proof(rule is_ntcfI')
show "vfsequence Ο" unfolding Ο_def by simp
show "vcard Ο = 5β©β" unfolding Ο_def by (simp add: nat_omega_simps)
show "vsv (Οβ¦NTMapβ¦)" unfolding Ο_components by auto
show "πβ©β (Οβ¦NTMapβ¦) = ββ¦Objβ¦" unfolding Ο_components by simp
show "Οβ¦NTMapβ¦β¦aβ¦ : πβ¦ObjMapβ¦β¦aβ¦ β¦βπβ ?the_cf_rKeβ¦ObjMapβ¦β¦aβ¦"
if "a ββ©β ββ¦Objβ¦" for a
using that
by
(
cs_concl
cs_simp: cat_cs_simps cat_Kan_cs_simps
cs_intro: cat_cs_intros cat_Kan_cs_intros
)
then have [cat_Kan_cs_intros]: "Οβ¦NTMapβ¦β¦aβ¦ : b β¦βπβ c"
if "a ββ©β ββ¦Objβ¦"
and "b = πβ¦ObjMapβ¦β¦aβ¦"
and "c = ?the_cf_rKeβ¦ObjMapβ¦β¦aβ¦"
for a b c
using that(1) unfolding that(2,3) by simp
show
"Οβ¦NTMapβ¦β¦bβ¦ ββ©Aβπβ πβ¦ArrMapβ¦β¦fβ¦ =
?the_cf_rKeβ¦ArrMapβ¦β¦fβ¦ ββ©Aβπβ Οβ¦NTMapβ¦β¦aβ¦"
if f_is_arr: "f : a β¦βββ b" for a b f
proof-
note f = π.HomCod.cat_is_arrD[OF that]
note lim_a = assms(3)[OF f(2)] and lim_b = assms(3)[OF f(3)]
interpret lim_a: is_cat_limit
Ξ± βΉa ββ©Cβ©F πβΊ π βΉπ ββ©Cβ©F a β©Oβ¨
β©Cβ©F πβΊ βΉ?UObj aβΊ βΉ?UArr aβΊ
by (rule lim_a)
interpret lim_b: is_cat_limit
Ξ± βΉb ββ©Cβ©F πβΊ π βΉπ ββ©Cβ©F b β©Oβ¨
β©Cβ©F πβΊ βΉ?UObj bβΊ βΉ?UArr bβΊ
by (rule lim_b)
from f have a: "a ββ©β ββ¦Objβ¦" and b: "b ββ©β ββ¦Objβ¦" by auto
from lim_b.cat_lim_unique_cone'[OF Ο[OF that]] obtain g'
where g': "g' : πβ¦ObjMapβ¦β¦aβ¦ β¦βπβ ?UObj b"
and Ο_NTMap_app: "βA. A ββ©β (b ββ©Cβ©F πβ¦Objβ¦) βΉ
Ο a b fβ¦NTMapβ¦β¦Aβ¦ = ?UArr bβ¦NTMapβ¦β¦Aβ¦ ββ©Aβπβ g'"
and g'_unique: "βg''.
β¦
g'' : πβ¦ObjMapβ¦β¦aβ¦ β¦βπβ ?UObj b;
βA. A ββ©β b ββ©Cβ©F πβ¦Objβ¦ βΉ
Ο a b fβ¦NTMapβ¦β¦Aβ¦ = ?UArr bβ¦NTMapβ¦β¦Aβ¦ ββ©Aβπβ g''
β§ βΉ g'' = g'"
by metis
have lim_Obj_a_fπ[symmetric, cat_Kan_cs_simps]:
"?UArr aβ¦NTMapβ¦β¦a', b', f' ββ©Aβββ fβ¦β©β =
?UArr bβ¦NTMapβ¦β¦Aβ¦ ββ©Aβπβ ?the_cf_rKeβ¦ArrMapβ¦β¦fβ¦"
if "A = [a', b', f']β©β" and "A ββ©β b ββ©Cβ©F πβ¦Objβ¦" for A a' b' f'
proof-
from that(2) f_is_arr have a'_def: "a' = 0"
and b': "b' ββ©β π
β¦Objβ¦"
and f': "f' : b β¦βββ πβ¦ObjMapβ¦β¦b'β¦"
unfolding that(1) by auto
show ?thesis
unfolding that(1)
by
(
rule
lim_Obj_the_cf_rKe_commute
[
where lim_Obj=lim_Obj,
OF
assms(1,2)
lim_a
lim_b
f_is_arr
that(2)[unfolded that(1)]
]
)
qed
{
fix a' b' f' A
note π.HomCod.cat_assoc_helper[
where h=βΉ?UArr bβ¦NTMapβ¦β¦a',b',f'β¦β©ββΊ
and g=βΉ?the_cf_rKeβ¦ArrMapβ¦β¦fβ¦βΊ
and q=βΉ?UArr aβ¦NTMapβ¦β¦a', b', f' ββ©Aβββ fβ¦β©ββΊ
]
}
note [cat_Kan_cs_simps] = this
show ?thesis
proof(rule trans_sym[where s=g'])
show "Οβ¦NTMapβ¦β¦bβ¦ ββ©Aβπβ πβ¦ArrMapβ¦β¦fβ¦ = g'"
proof(rule g'_unique)
from that show
"Οβ¦NTMapβ¦β¦bβ¦ ββ©Aβπβ πβ¦ArrMapβ¦β¦fβ¦ : πβ¦ObjMapβ¦β¦aβ¦ β¦βπβ ?UObj b"
by (cs_concl cs_intro: cat_cs_intros cat_Kan_cs_intros)
fix A assume prems': "A ββ©β b ββ©Cβ©F πβ¦Objβ¦"
with f_is_arr obtain b' f'
where A_def: "A = [0, b', f']β©β"
and b': "b' ββ©β π
β¦Objβ¦"
and f': "f' : b β¦βββ πβ¦ObjMapβ¦β¦b'β¦"
by auto
from f_is_arr prems' show
"Ο a b fβ¦NTMapβ¦β¦Aβ¦ =
?UArr bβ¦NTMapβ¦β¦Aβ¦ ββ©Aβπβ (Οβ¦NTMapβ¦β¦bβ¦ ββ©Aβπβ πβ¦ArrMapβ¦β¦fβ¦)"
unfolding A_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_Kan_cs_simps
cs_intro: cat_cs_intros cat_Kan_cs_intros
)
qed
show "?the_cf_rKeβ¦ArrMapβ¦β¦fβ¦ ββ©Aβπβ Οβ¦NTMapβ¦β¦aβ¦ = g'"
proof(rule g'_unique)
fix A assume prems': "A ββ©β b ββ©Cβ©F πβ¦Objβ¦"
with f_is_arr obtain b' f'
where A_def: "A = [0, b', f']β©β"
and b': "b' ββ©β π
β¦Objβ¦"
and f': "f' : b β¦βββ πβ¦ObjMapβ¦β¦b'β¦"
by auto
{
fix a' b' f' A
note π.HomCod.cat_assoc_helper
[
where h=βΉ?UArr bβ¦NTMapβ¦β¦a', b', f'β¦β©ββΊ
and g=βΉΟβ¦NTMapβ¦β¦bβ¦βΊ
and q=βΉΞ΅β¦NTMapβ¦β¦b'β¦ ββ©Aβπβ πβ¦ArrMapβ¦β¦f'β¦βΊ
]
}
note [cat_Kan_cs_simps] =
this
Ξ΅b_πf[OF A_def prems' b, symmetric]
Ξ΅b_πf[symmetric]
from f_is_arr prems' b' f' show
"Ο a b fβ¦NTMapβ¦β¦Aβ¦ =
?UArr bβ¦NTMapβ¦β¦Aβ¦ ββ©Aβπβ
(?the_cf_rKeβ¦ArrMapβ¦β¦fβ¦ ββ©Aβπβ Οβ¦NTMapβ¦β¦aβ¦)"
unfolding A_def
by
(
cs_concl
cs_simp:
cat_cs_simps
cat_Kan_cs_simps
cat_comma_cs_simps
cat_op_simps
cs_intro:
cat_cs_intros
cat_Kan_cs_intros
cat_comma_cs_intros
cat_op_intros
)
qed
(
use that in
βΉ
cs_concl
cs_simp: cat_Kan_cs_simps
cs_intro: cat_cs_intros cat_Kan_cs_intros
βΊ
)
qed
qed
qed
(
cs_concl
cs_simp: cat_cs_simps cat_Kan_cs_simps
cs_intro: cat_cs_intros
)+
then interpret Ο: is_ntcf Ξ± β π π βΉ?the_cf_rKeβΊ Ο by simp
show "Ξ΅ = ?the_ntcf_rKe ββ©Nβ©Tβ©Cβ©F (Ο ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π)"
proof(rule ntcf_eqI)
have dom_lhs: "πβ©β (Ξ΅β¦NTMapβ¦) = π
β¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps)
have dom_rhs: "πβ©β ((?the_ntcf_rKe ββ©Nβ©Tβ©Cβ©F (Ο ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π))β¦NTMapβ¦) = π
β¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "Ξ΅β¦NTMapβ¦ = (?the_ntcf_rKe ββ©Nβ©Tβ©Cβ©F (Ο ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π))β¦NTMapβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix b assume prems': "b ββ©β π
β¦Objβ¦"
note [cat_Kan_cs_simps] = Ξ΅b_πf[
where f=βΉββ¦CIdβ¦β¦πβ¦ObjMapβ¦β¦bβ¦β¦βΊ and c=βΉπβ¦ObjMapβ¦β¦bβ¦βΊ, symmetric
]
from prems' Ο show
"Ξ΅β¦NTMapβ¦β¦bβ¦ = (?the_ntcf_rKe ββ©Nβ©Tβ©Cβ©F (Ο ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π))β¦NTMapβ¦β¦bβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps cat_comma_cs_simps cat_Kan_cs_simps
cs_intro: cat_cs_intros cat_comma_cs_intros cat_Kan_cs_intros
)
qed (cs_concl cs_intro: cat_cs_intros V_cs_intros)
qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
fix Ο' assume prems':
"Ο' : π β¦β©Cβ©F ?the_cf_rKe : β β¦β¦β©CβΞ±β π"
"Ξ΅ = ?the_ntcf_rKe ββ©Nβ©Tβ©Cβ©F (Ο' ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π)"
interpret Ο': is_ntcf Ξ± β π π βΉ?the_cf_rKeβΊ Ο' by (rule prems'(1))
have Ξ΅_NTMap_app[symmetric, cat_Kan_cs_simps]:
"Ξ΅β¦NTMapβ¦β¦b'β¦ =
?UArr (πβ¦ObjMapβ¦β¦b'β¦)β¦NTMapβ¦β¦a', b', ββ¦CIdβ¦β¦πβ¦ObjMapβ¦β¦b'β¦β¦β¦β©β ββ©Aβπβ
Ο'β¦NTMapβ¦β¦πβ¦ObjMapβ¦β¦b'β¦β¦"
if "b' ββ©β π
β¦Objβ¦" and "a' = 0" for a' b'
proof-
from prems'(2) have Ξ΅_NTMap_app:
"Ξ΅β¦NTMapβ¦β¦b'β¦ = (?the_ntcf_rKe ββ©Nβ©Tβ©Cβ©F (Ο' ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π))β¦NTMapβ¦β¦b'β¦"
for b'
by simp
show ?thesis
using Ξ΅_NTMap_app[of b'] that(1)
unfolding that(2)
by
(
cs_prems
cs_simp: cat_cs_simps cat_comma_cs_simps cat_Kan_cs_simps
cs_intro: cat_cs_intros cat_comma_cs_intros
)
qed
{
fix a' b' f' A
note π.HomCod.cat_assoc_helper
[
where h=
βΉ?UArr (πβ¦ObjMapβ¦β¦b'β¦)β¦NTMapβ¦β¦a', b', ββ¦CIdβ¦β¦πβ¦ObjMapβ¦β¦b'β¦β¦β¦β©ββΊ
and g=βΉΟ'β¦NTMapβ¦β¦πβ¦ObjMapβ¦β¦b'β¦β¦βΊ
and q=βΉΞ΅β¦NTMapβ¦β¦b'β¦βΊ
]
}
note [cat_Kan_cs_simps] = this Ξ΅b_πf[symmetric]
{
fix a' b' f' A
note π.HomCod.cat_assoc_helper
[
where h=βΉ
?UArr (πβ¦ObjMapβ¦β¦b'β¦)β¦NTMapβ¦β¦
a', b', ββ¦CIdβ¦β¦πβ¦ObjMapβ¦β¦b'β¦β¦
β¦β©ββΊ
and g=βΉΟβ¦NTMapβ¦β¦πβ¦ObjMapβ¦β¦b'β¦β¦βΊ
and q=βΉΞ΅β¦NTMapβ¦β¦b'β¦βΊ
]
}
note [cat_Kan_cs_simps] = this
show "Ο' = Ο"
proof(rule ntcf_eqI)
show "Ο' : π β¦β©Cβ©F ?the_cf_rKe : β β¦β¦β©CβΞ±β π" by (rule prems'(1))
show "Ο : π β¦β©Cβ©F ?the_cf_rKe : β β¦β¦β©CβΞ±β π" by (rule Ο)
have dom_lhs: "πβ©β (Οβ¦NTMapβ¦) = ββ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps)
have dom_rhs: "πβ©β (Ο'β¦NTMapβ¦) = ββ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps)
show "Ο'β¦NTMapβ¦ = Οβ¦NTMapβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix c assume prems': "c ββ©β ββ¦Objβ¦"
note lim_c = assms(3)[OF prems']
interpret lim_c: is_cat_limit
Ξ± βΉc ββ©Cβ©F πβΊ π βΉπ ββ©Cβ©F c β©Oβ¨
β©Cβ©F πβΊ βΉ?UObj cβΊ βΉ?UArr cβΊ
by (rule lim_c)
from prems' have CId_c: "ββ¦CIdβ¦β¦cβ¦ : c β¦βββ c"
by (cs_concl cs_intro: cat_cs_intros)
from lim_c.cat_lim_unique_cone'[OF Ο[OF CId_c]] obtain f
where f: "f : πβ¦ObjMapβ¦β¦cβ¦ β¦βπβ ?UObj c"
and "βA. A ββ©β c ββ©Cβ©F πβ¦Objβ¦ βΉ
Ο c c (ββ¦CIdβ¦β¦cβ¦)β¦NTMapβ¦β¦Aβ¦ = ?UArr cβ¦NTMapβ¦β¦Aβ¦ ββ©Aβπβ f"
and f_unique: "βf'.
β¦
f' : πβ¦ObjMapβ¦β¦cβ¦ β¦βπβ ?UObj c;
βA. A ββ©β c ββ©Cβ©F πβ¦Objβ¦ βΉ
Ο c c (ββ¦CIdβ¦β¦cβ¦)β¦NTMapβ¦β¦Aβ¦ = ?UArr cβ¦NTMapβ¦β¦Aβ¦ ββ©Aβπβ f'
β§ βΉ f' = f"
by metis
note [symmetric, cat_cs_simps] =
Ο.ntcf_Comp_commute
Ο'.ntcf_Comp_commute
show "Ο'β¦NTMapβ¦β¦cβ¦ = Οβ¦NTMapβ¦β¦cβ¦"
proof(rule trans_sym[where s=f])
show "Ο'β¦NTMapβ¦β¦cβ¦ = f"
proof(rule f_unique)
fix A assume prems'': "A ββ©β c ββ©Cβ©F πβ¦Objβ¦"
with prems' obtain b' f'
where A_def: "A = [0, b', f']β©β"
and b': "b' ββ©β π
β¦Objβ¦"
and f': "f' : c β¦βββ πβ¦ObjMapβ¦β¦b'β¦"
by auto
let ?πb' = βΉπβ¦ObjMapβ¦β¦b'β¦βΊ
from b' have πb': "?πb' ββ©β ββ¦Objβ¦"
by (cs_concl cs_intro: cat_cs_intros)
interpret lim_πb': is_cat_limit
Ξ± βΉ?πb' ββ©Cβ©F πβΊ π βΉπ ββ©Cβ©F ?πb' β©Oβ¨
β©Cβ©F πβΊ βΉ?UObj ?πb'βΊ βΉ?UArr ?πb'βΊ
by (rule assms(3)[OF πb'])
from πb' have CId_πb': "ββ¦CIdβ¦β¦?πb'β¦ : ?πb' β¦βββ ?πb'"
by (cs_concl cs_intro: cat_cs_intros)
from CId_πb' b' have a'_b'_CId_πb':
"[0, b', ββ¦CIdβ¦β¦?πb'β¦]β©β ββ©β ?πb' ββ©Cβ©F πβ¦Objβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps cat_comma_cs_simps
cs_intro: cat_cs_intros cat_comma_cs_intros
)
from
lim_Obj_the_cf_rKe_commute[
where lim_Obj=lim_Obj,
OF assms(1,2) lim_c assms(3)[OF πb'] f' a'_b'_CId_πb'
]
f'
have [cat_Kan_cs_simps]:
"?UArr cβ¦NTMapβ¦β¦0, b', f'β¦β©β =
?UArr ?πb'β¦NTMapβ¦β¦0, b', ββ¦CIdβ¦β¦?πb'β¦β¦β©β ββ©Aβπβ
?the_cf_rKeβ¦ArrMapβ¦β¦f'β¦"
by (cs_prems cs_simp: cat_cs_simps)
from prems' prems'' b' f' show
"Ο c c (ββ¦CIdβ¦β¦cβ¦)β¦NTMapβ¦β¦Aβ¦ = ?UArr cβ¦NTMapβ¦β¦Aβ¦ ββ©Aβπβ Ο'β¦NTMapβ¦β¦cβ¦"
unfolding A_def
by
(
cs_concl
cs_simp:
cat_cs_simps cat_comma_cs_simps cat_Kan_cs_simps
cs_intro:
cat_cs_intros cat_comma_cs_intros cat_Kan_cs_intros
)
qed
(
use prems' in
βΉcs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_introsβΊ
)
show "Οβ¦NTMapβ¦β¦cβ¦ = f"
proof(rule f_unique)
fix A assume prems'': "A ββ©β c ββ©Cβ©F πβ¦Objβ¦"
from this prems' obtain b' f'
where A_def: "A = [0, b', f']β©β"
and b': "b' ββ©β π
β¦Objβ¦"
and f': "f' : c β¦βββ πβ¦ObjMapβ¦β¦b'β¦"
by auto
let ?πb' = βΉπβ¦ObjMapβ¦β¦b'β¦βΊ
from b' have πb': "?πb' ββ©β ββ¦Objβ¦"
by (cs_concl cs_intro: cat_cs_intros)
interpret lim_πb': is_cat_limit
Ξ± βΉ?πb' ββ©Cβ©F πβΊ π βΉπ ββ©Cβ©F ?πb' β©Oβ¨
β©Cβ©F πβΊ βΉ?UObj ?πb'βΊ βΉ?UArr ?πb'βΊ
by (rule assms(3)[OF πb'])
from πb' have CId_πb': "ββ¦CIdβ¦β¦?πb'β¦ : ?πb' β¦βββ ?πb'"
by (cs_concl cs_intro: cat_cs_intros)
from CId_πb' b' have a'_b'_CId_πb':
"[0, b', ββ¦CIdβ¦β¦?πb'β¦]β©β ββ©β ?πb' ββ©Cβ©F πβ¦Objβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps cat_comma_cs_simps
cs_intro: cat_cs_intros cat_comma_cs_intros
)
from
lim_Obj_the_cf_rKe_commute
[
where lim_Obj=lim_Obj,
OF assms(1,2) lim_c assms(3)[OF πb'] f' a'_b'_CId_πb'
]
f'
have [cat_Kan_cs_simps]:
"?UArr cβ¦NTMapβ¦β¦0, b', f'β¦β©β =
?UArr (?πb')β¦NTMapβ¦β¦0, b', ββ¦CIdβ¦β¦?πb'β¦β¦β©β ββ©Aβπβ
?the_cf_rKeβ¦ArrMapβ¦β¦f'β¦"
by (cs_prems cs_simp: cat_cs_simps)
from prems' prems'' b' f' show
"Ο c c (ββ¦CIdβ¦β¦cβ¦)β¦NTMapβ¦β¦Aβ¦ = ?UArr cβ¦NTMapβ¦β¦Aβ¦ ββ©Aβπβ Οβ¦NTMapβ¦β¦cβ¦"
unfolding A_def
by
(
cs_concl
cs_simp:
cat_cs_simps cat_comma_cs_simps cat_Kan_cs_simps
cs_intro:
cat_cs_intros cat_comma_cs_intros cat_Kan_cs_intros
)
qed
(
use prems' in
βΉcs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_introsβΊ
)
qed
qed auto
qed simp_all
qed
qed (cs_concl cs_intro: cat_cs_intros)+
qed
subsectionβΉPreservation of Kan extensionβΊ
textβΉ
The following definitions are similar to the definitions that can be
found in \cite{riehl_category_2016} or \cite{lehner_all_2014}.
βΊ
locale is_cat_rKe_preserves =
is_cat_rKe Ξ± π
β π π π π Ξ΅ + is_functor Ξ± π π β
for Ξ± π
β π π π π π β Ξ΅ +
assumes cat_rKe_preserves:
"β ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F Ξ΅ : (β ββ©Cβ©F π) ββ©Cβ©F π β¦β©Cβ©Fβ©.β©rβ©Kβ©eβΞ±β β ββ©Cβ©F π : π
β¦β©C β β¦β©C π"
syntax "_is_cat_rKe_preserves" ::
"V β V β V β V β V β V β V β V β V β V β bool"
(
βΉ(_ :/ _ ββ©Cβ©F _ β¦β©Cβ©Fβ©.β©rβ©Kβ©eΔ± _ :/ _ β¦β©C _ β¦β©C _ : _ β¦β¦β©C _)βΊ
[51, 51, 51, 51, 51, 51, 51, 51, 51] 51
)
translations "Ξ΅ : π ββ©Cβ©F π β¦β©Cβ©Fβ©.β©rβ©Kβ©eβΞ±β π : π
β¦β©C β β¦β©C (β : π β¦β¦β©C π)" β
"CONST is_cat_rKe_preserves Ξ± π
β π π π π π β Ξ΅"
locale is_cat_lKe_preserves =
is_cat_lKe Ξ± π
β π π π π Ξ· + is_functor Ξ± π π β
for Ξ± π
β π π π π π β Ξ· +
assumes cat_lKe_preserves:
"β ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F Ξ· : β ββ©Cβ©F π β¦β©Cβ©Fβ©.β©lβ©Kβ©eβΞ±β (β ββ©Cβ©F π) ββ©Cβ©F π : π
β¦β©C β β¦β©C π"
syntax "_is_cat_lKe_preserves" ::
"V β V β V β V β V β V β V β V β V β V β bool"
(
βΉ(_ :/ _ β¦β©Cβ©Fβ©.β©lβ©Kβ©eΔ± _ ββ©Cβ©F _ :/ _ β¦β©C _ β¦β©C _ : _ β¦β¦β©C _)βΊ
[51, 51, 51, 51, 51, 51, 51, 51, 51] 51
)
translations "Ξ· : π β¦β©Cβ©Fβ©.β©lβ©Kβ©eβΞ±β π ββ©Cβ©F π : π
β¦β©C β β¦β©C (β : π β¦β¦β©C π)" β
"CONST is_cat_lKe_preserves Ξ± π
β π π π π π β Ξ·"
textβΉRules.βΊ
lemma (in is_cat_rKe_preserves) is_cat_rKe_preserves_axioms':
assumes "Ξ±' = Ξ±"
and "π' = π"
and "π' = π"
and "π' = π"
and "β' = β"
and "π
' = π
"
and "π' = π"
and "β' = β"
and "π' = π"
shows "Ξ΅ : π' ββ©Cβ©F π' β¦β©Cβ©Fβ©.β©rβ©Kβ©eβΞ±'β π' : π
' β¦β©C β' β¦β©C (β' : π' β¦β¦β©C π')"
unfolding assms by (rule is_cat_rKe_preserves_axioms)
mk_ide rf is_cat_rKe_preserves_def[unfolded is_cat_rKe_preserves_axioms_def]
|intro is_cat_rKe_preservesI|
|dest is_cat_rKe_preservesD[dest]|
|elim is_cat_rKe_preservesE[elim]|
lemmas [cat_Kan_cs_intros] = is_cat_rKeD(1-3)
lemma (in is_cat_lKe_preserves) is_cat_lKe_preserves_axioms':
assumes "Ξ±' = Ξ±"
and "π' = π"
and "π' = π"
and "π' = π"
and "β' = β"
and "π
' = π
"
and "π' = π"
and "β' = β"
and "π' = π"
shows "Ξ· : π' β¦β©Cβ©Fβ©.β©lβ©Kβ©eβΞ±β π' ββ©Cβ©F π' : π
' β¦β©C β' β¦β©C (β' : π' β¦β¦β©C π')"
unfolding assms by (rule is_cat_lKe_preserves_axioms)
mk_ide rf is_cat_lKe_preserves_def[unfolded is_cat_lKe_preserves_axioms_def]
|intro is_cat_lKe_preservesI|
|dest is_cat_lKe_preservesD[dest]|
|elim is_cat_lKe_preservesE[elim]|
lemmas [cat_Kan_cs_intros] = is_cat_lKe_preservesD(1-3)
textβΉDuality.βΊ
lemma (in is_cat_rKe_preserves) is_cat_rKe_preserves_op:
"op_ntcf Ξ΅ :
op_cf π β¦β©Cβ©Fβ©.β©lβ©Kβ©eβΞ±β op_cf π ββ©Cβ©F op_cf π :
op_cat π
β¦β©C op_cat β β¦β©C (op_cf β : op_cat π β¦β¦β©C op_cat π)"
proof(intro is_cat_lKe_preservesI)
from cat_rKe_preserves show "op_cf β ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F op_ntcf Ξ΅ :
op_cf β ββ©Cβ©F op_cf π β¦β©Cβ©Fβ©.β©lβ©Kβ©eβΞ±β (op_cf β ββ©Cβ©F op_cf π) ββ©Cβ©F op_cf π :
op_cat π
β¦β©C op_cat β β¦β©C op_cat π"
by (cs_concl_step op_ntcf_cf_ntcf_comp[symmetric])
(cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)
qed (cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)+
lemma (in is_cat_rKe_preserves) is_cat_lKe_preserves_op'[cat_op_intros]:
assumes "π' = op_cf π"
and "π' = op_cf π"
and "π' = op_cf π"
and "π
' = op_cat π
"
and "π' = op_cat π"
and "β' = op_cat β"
and "π' = op_cat π"
and "β' = op_cf β"
shows "op_ntcf Ξ΅ :
π' β¦β©Cβ©Fβ©.β©lβ©Kβ©eβΞ±β π' ββ©Cβ©F π' : π
' β¦β©C β' β¦β©C (β' : π' β¦β¦β©C π')"
unfolding assms by (rule is_cat_rKe_preserves_op)
lemmas [cat_op_intros] = is_cat_rKe_preserves.is_cat_lKe_preserves_op'
lemma (in is_cat_lKe_preserves) is_cat_rKe_preserves_op:
"op_ntcf Ξ· :
op_cf π ββ©Cβ©F op_cf π β¦β©Cβ©Fβ©.β©rβ©Kβ©eβΞ±β op_cf π :
op_cat π
β¦β©C op_cat β β¦β©C (op_cf β : op_cat π β¦β¦β©C op_cat π)"
proof(intro is_cat_rKe_preservesI)
from cat_lKe_preserves show "op_cf β ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F op_ntcf Ξ· :
(op_cf β ββ©Cβ©F op_cf π) ββ©Cβ©F op_cf π β¦β©Cβ©Fβ©.β©rβ©Kβ©eβΞ±β op_cf β ββ©Cβ©F op_cf π :
op_cat π
β¦β©C op_cat β β¦β©C op_cat π"
by (cs_concl_step op_ntcf_cf_ntcf_comp[symmetric])
(cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)
qed (cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)+
lemma (in is_cat_lKe_preserves) is_cat_rKe_preserves_op'[cat_op_intros]:
assumes "π' = op_cf π"
and "π' = op_cf π"
and "π' = op_cf π"
and "β' = op_cf β"
and "π
' = op_cat π
"
and "π' = op_cat π"
and "β' = op_cat β"
and "π' = op_cat π"
shows "op_ntcf Ξ· :
π' ββ©Cβ©F π' β¦β©Cβ©Fβ©.β©rβ©Kβ©eβΞ±β π' : π
' β¦β©C β' β¦β©C (β' : π' β¦β¦β©C π')"
unfolding assms by (rule is_cat_rKe_preserves_op)
subsectionβΉAll concepts are Kan extensionsβΊ
textβΉ
Background information for this subsection is provided in
Chapter X-7 in \cite{mac_lane_categories_2010}
and section 6.5 in \cite{riehl_category_2016}.
It should be noted that only the connections between the Kan extensions,
limits and adjunctions are exposed (an alternative proof of the Yoneda
lemma using Kan extensions is not provided in the context of this work).
βΊ
subsubsectionβΉLimitsβΊ
lemma cat_rKe_is_cat_limit:
assumes "Ξ΅ : π ββ©Cβ©F π β¦β©Cβ©Fβ©.β©rβ©Kβ©eβΞ±β π : π
β¦β©C cat_1 π π£ β¦β©C π"
and "π : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β π"
shows "Ξ΅ : πβ¦ObjMapβ¦β¦πβ¦ <β©Cβ©Fβ©.β©lβ©iβ©m π : π
β¦β¦β©CβΞ±β π"
proof-
interpret Ξ΅: is_cat_rKe Ξ± π
βΉcat_1 π π£βΊ π π π π Ξ΅ by (rule assms(1))
interpret π: is_tm_functor Ξ± π
π π by (rule assms(2))
from cat_1_components(1) have π: "π ββ©β Vset Ξ±"
by (auto simp: Ξ΅.AG.HomCod.cat_in_Obj_in_Vset)
from cat_1_components(2) have π£: "π£ ββ©β Vset Ξ±"
by (auto simp: Ξ΅.AG.HomCod.cat_in_Arr_in_Vset)
have π_def: "π = cf_const π
(cat_1 π π£) π"
by (rule cf_const_if_HomCod_is_cat_1)
(cs_concl cs_intro: cat_cs_intros)
have ππ_def: "π ββ©Cβ©F π = cf_const π
π (πβ¦ObjMapβ¦β¦πβ¦)"
by
(
cs_concl
cs_simp: cat_1_components(1) π_def cat_cs_simps
cs_intro: V_cs_intros cat_cs_intros
)
interpret Ξ΅: is_tm_ntcf Ξ± π
π βΉπ ββ©Cβ©F πβΊ π Ξ΅
by
(
intro is_tm_ntcfI' assms(2) Ξ΅.ntcf_rKe.is_ntcf_axioms,
unfold ππ_def
)
(
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_small_cs_intros cat_cs_intros
)
show "Ξ΅ : πβ¦ObjMapβ¦β¦πβ¦ <β©Cβ©Fβ©.β©lβ©iβ©m π : π
β¦β¦β©CβΞ±β π"
proof(intro is_cat_limitI' is_cat_coneI)
show "Ξ΅ : cf_const π
π (πβ¦ObjMapβ¦β¦πβ¦) β¦β©Cβ©Fβ©.β©tβ©m π : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β π"
proof(intro is_tm_ntcfI' Ξ΅.ntcf_rKe.is_ntcf_axioms[unfolded ππ_def])
from assms(2) show "cf_const π
π (πβ¦ObjMapβ¦β¦πβ¦) : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β π"
by (cs_concl cs_intro: cat_small_cs_intros cat_cs_intros)
qed (rule assms(2))
fix u' r' assume prems: "u' : r' <β©Cβ©Fβ©.β©cβ©oβ©nβ©e π : π
β¦β¦β©CβΞ±β π"
interpret u': is_cat_cone Ξ± r' π
π π u' by (rule prems)
have π_def: "π = cf_const (cat_1 π π£) π (πβ¦ObjMapβ¦β¦πβ¦)"
by (rule cf_const_if_HomDom_is_cat_1[OF Ξ΅.Ran.is_functor_axioms])
from prems have const_r': "cf_const (cat_1 π π£) π r' : cat_1 π π£ β¦β¦β©CβΞ±β π"
by
(
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_lim_cs_intros cat_cs_intros
)
have cf_comp_cf_const_r_π_def:
"cf_const (cat_1 π π£) π r' ββ©Cβ©F π = cf_const π
π r'"
by
(
cs_concl
cs_simp: cat_cs_simps π_def
cs_intro: cat_cs_intros cat_lim_cs_intros
)
from Ξ΅.cat_rKe_unique[
OF const_r', unfolded cf_comp_cf_const_r_π_def, OF u'.is_ntcf_axioms
]
obtain Ο
where Ο: "Ο : cf_const (cat_1 π π£) π r' β¦β©Cβ©F π : cat_1 π π£ β¦β¦β©CβΞ±β π"
and u'_def: "u' = Ξ΅ ββ©Nβ©Tβ©Cβ©F (Ο ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π)"
and unique_Ο: "βΟ'.
β¦
Ο' : cf_const (cat_1 π π£) π r' β¦β©Cβ©F π : cat_1 π π£ β¦β¦β©CβΞ±β π;
u' = Ξ΅ ββ©Nβ©Tβ©Cβ©F (Ο' ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π)
β§ βΉ Ο' = Ο"
by auto
interpret Ο: is_ntcf Ξ± βΉcat_1 π π£βΊ π βΉcf_const (cat_1 π π£) π r'βΊ π Ο
by (rule Ο)
show "β!f'. f' : r' β¦βπβ πβ¦ObjMapβ¦β¦πβ¦ β§ u' = Ξ΅ ββ©Nβ©Tβ©Cβ©F ntcf_const π
π f'"
proof(intro ex1I conjI; (elim conjE)?)
fix f' assume prems':
"f' : r' β¦βπβ πβ¦ObjMapβ¦β¦πβ¦" "u' = Ξ΅ ββ©Nβ©Tβ©Cβ©F ntcf_const π
π f'"
from prems'(1) have "ntcf_const (cat_1 π π£) π f' :
cf_const (cat_1 π π£) π r' β¦β©Cβ©F π : cat_1 π π£ β¦β¦β©CβΞ±β π"
by (subst π_def)
(cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
moreover then have "u' = Ξ΅ ββ©Nβ©Tβ©Cβ©F (ntcf_const (cat_1 π π£) π f' ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π)"
by
(
cs_concl
cs_simp: cat_cs_simps prems'(2) π_def cs_intro: cat_cs_intros
)
ultimately have Ο_def: "Ο = ntcf_const (cat_1 π π£) π f'"
by (auto simp: unique_Ο[symmetric])
show "f' = Οβ¦NTMapβ¦β¦πβ¦"
by (cs_concl cs_simp: cat_cs_simps Ο_def cs_intro: cat_cs_intros)
qed (cs_concl cs_simp: cat_cs_simps u'_def π_def cs_intro: cat_cs_intros)+
qed (cs_concl cs_simp: π_def cs_intro: cat_cs_intros)
qed
lemma cat_lKe_is_cat_colimit:
assumes "Ξ· : π β¦β©Cβ©Fβ©.β©lβ©Kβ©eβΞ±β π ββ©Cβ©F π : π
β¦β©C cat_1 π π£ β¦β©C π"
and "π : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β π"
shows "Ξ· : π >β©Cβ©Fβ©.β©cβ©oβ©lβ©iβ©m πβ¦ObjMapβ¦β¦πβ¦ : π
β¦β¦β©CβΞ±β π"
proof-
interpret Ξ·: is_cat_lKe Ξ± π
βΉcat_1 π π£βΊ π π π π Ξ· by (rule assms(1))
interpret π: is_tm_functor Ξ± π
π π by (rule assms(2))
from cat_1_components(1) have π: "π ββ©β Vset Ξ±"
by (auto simp: Ξ·.AG.HomCod.cat_in_Obj_in_Vset)
from cat_1_components(2) have π£: "π£ ββ©β Vset Ξ±"
by (auto simp: Ξ·.AG.HomCod.cat_in_Arr_in_Vset)
show ?thesis
by
(
rule is_cat_limit.is_cat_colimit_op
[
OF cat_rKe_is_cat_limit[
OF Ξ·.is_cat_rKe_op[unfolded Ξ·.AG.cat_1_op[OF π π£]]
π.is_tm_functor_op
],
unfolded cat_op_simps
]
)
qed
lemma cat_limit_is_rKe:
assumes "Ξ΅ : πβ¦ObjMapβ¦β¦πβ¦ <β©Cβ©Fβ©.β©lβ©iβ©m π : π
β¦β¦β©CβΞ±β π"
and "π : π
β¦β¦β©CβΞ±β cat_1 π π£"
and "π : cat_1 π π£ β¦β¦β©CβΞ±β π"
shows "Ξ΅ : π ββ©Cβ©F π β¦β©Cβ©Fβ©.β©rβ©Kβ©eβΞ±β π : π
β¦β©C cat_1 π π£ β¦β©C π"
proof-
interpret Ξ΅: is_cat_limit Ξ± π
π π βΉπβ¦ObjMapβ¦β¦πβ¦βΊ Ξ΅ by (rule assms)
interpret π: is_functor Ξ± π
βΉcat_1 π π£βΊ π by (rule assms(2))
interpret π: is_functor Ξ± βΉcat_1 π π£βΊ π π by (rule assms(3))
show ?thesis
proof(rule is_cat_rKeI')
note π_def = cf_const_if_HomCod_is_cat_1[OF assms(2)]
note π_def = cf_const_if_HomDom_is_cat_1[OF assms(3)]
have ππ_def: "π ββ©Cβ©F π = cf_const π
π (πβ¦ObjMapβ¦β¦πβ¦)"
by (subst π_def, use nothing in βΉsubst π_defβΊ)
(cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "Ξ΅ : π ββ©Cβ©F π β¦β©Cβ©F π : π
β¦β¦β©CβΞ±β π"
by (cs_concl cs_simp: cat_cs_simps ππ_def cs_intro: cat_cs_intros)
fix π' Ξ΅' assume prems:
"π' : cat_1 π π£ β¦β¦β©CβΞ±β π"
"Ξ΅' : π' ββ©Cβ©F π β¦β©Cβ©F π : π
β¦β¦β©CβΞ±β π"
interpret is_functor Ξ± βΉcat_1 π π£βΊ π π' by (rule prems(1))
note π'_def = cf_const_if_HomDom_is_cat_1[OF prems(1)]
from prems(2) have Ξ΅':
"Ξ΅' : cf_const π
π (π'β¦ObjMapβ¦β¦πβ¦) β¦β©Cβ©F π : π
β¦β¦β©CβΞ±β π"
unfolding π_def
by (subst (asm) π'_def)
(cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from prems(2) have "Ξ΅' : π'β¦ObjMapβ¦β¦πβ¦ <β©Cβ©Fβ©.β©cβ©oβ©nβ©e π : π
β¦β¦β©CβΞ±β π"
by (intro is_cat_coneI is_tm_ntcfI' Ξ΅')
(cs_concl cs_intro: cat_small_cs_intros cat_cs_intros)+
from Ξ΅.cat_lim_unique_cone[OF this] obtain f'
where f': "f' : π'β¦ObjMapβ¦β¦πβ¦ β¦βπβ πβ¦ObjMapβ¦β¦πβ¦"
and Ξ΅_def: "Ξ΅' = Ξ΅ ββ©Nβ©Tβ©Cβ©F ntcf_const π
π f'"
and unique_f':
"β¦
f'' : π'β¦ObjMapβ¦β¦πβ¦ β¦βπβ πβ¦ObjMapβ¦β¦πβ¦;
Ξ΅' = Ξ΅ ββ©Nβ©Tβ©Cβ©F ntcf_const π
π f''
β§ βΉ f'' = f'"
for f''
by metis
show "β!Ο.
Ο : π' β¦β©Cβ©F π : cat_1 π π£ β¦β¦β©CβΞ±β π β§ Ξ΅' = Ξ΅ ββ©Nβ©Tβ©Cβ©F (Ο ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π)"
proof(intro ex1I conjI; (elim conjE)?)
from f' show
"ntcf_const (cat_1 π π£) π f' : π' β¦β©Cβ©F π : cat_1 π π£ β¦β¦β©CβΞ±β π"
by (subst π'_def, use nothing in βΉsubst π_defβΊ)
(cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
then show "Ξ΅' = Ξ΅ ββ©Nβ©Tβ©Cβ©F (ntcf_const (cat_1 π π£) π f' ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π)"
by (cs_concl cs_simp: cat_cs_simps Ξ΅_def π_def cs_intro: cat_cs_intros)
fix Ο assume prems:
"Ο : π' β¦β©Cβ©F π : cat_1 π π£ β¦β¦β©CβΞ±β π"
"Ξ΅' = Ξ΅ ββ©Nβ©Tβ©Cβ©F (Ο ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π)"
interpret Ο: is_ntcf Ξ± βΉcat_1 π π£βΊ π π' π Ο by (rule prems(1))
have "Οβ¦NTMapβ¦β¦πβ¦ : π'β¦ObjMapβ¦β¦πβ¦ β¦βπβ πβ¦ObjMapβ¦β¦πβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
moreover have "Ξ΅' = Ξ΅ ββ©Nβ©Tβ©Cβ©F ntcf_const π
π (Οβ¦NTMapβ¦β¦πβ¦)"
by
(
cs_concl
cs_simp: cat_cs_simps prems(2) π_def cs_intro: cat_cs_intros
)
ultimately have Οπ: "Οβ¦NTMapβ¦β¦πβ¦ = f'" by (rule unique_f')
show "Ο = ntcf_const (cat_1 π π£) π f'"
proof(rule ntcf_eqI)
from f' show
"ntcf_const (cat_1 π π£) π f' : π' β¦β©Cβ©F π : cat_1 π π£ β¦β¦β©CβΞ±β π"
by (subst π'_def, use nothing in βΉsubst π_defβΊ)
(cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
have dom_lhs: "πβ©β (Οβ¦NTMapβ¦) = cat_1 π π£β¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro:cat_cs_intros)
have dom_rhs: "πβ©β (ntcf_const (cat_1 π π£) π f'β¦NTMapβ¦) = cat_1 π π£β¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro:cat_cs_intros)
show "Οβ¦NTMapβ¦ = ntcf_const (cat_1 π π£) π f'β¦NTMapβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix a assume prems: "a ββ©β cat_1 π π£β¦Objβ¦"
then have a_def: "a = π" unfolding cat_1_components by simp
from f' show "Οβ¦NTMapβ¦β¦aβ¦ = ntcf_const (cat_1 π π£) π f'β¦NTMapβ¦β¦aβ¦"
unfolding a_def Οπ
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed (auto intro: cat_cs_intros)
qed (simp_all add: prems)
qed
qed (auto simp: assms)
qed
lemma cat_colimit_is_lKe:
assumes "Ξ· : π >β©Cβ©Fβ©.β©cβ©oβ©lβ©iβ©m πβ¦ObjMapβ¦β¦πβ¦ : π
β¦β¦β©CβΞ±β π"
and "π : π
β¦β¦β©CβΞ±β cat_1 π π£"
and "π : cat_1 π π£ β¦β¦β©CβΞ±β π"
shows "Ξ· : π β¦β©Cβ©Fβ©.β©lβ©Kβ©eβΞ±β π ββ©Cβ©F π : π
β¦β©C cat_1 π π£ β¦β©C π"
proof-
interpret Ξ·: is_cat_colimit Ξ± π
π π βΉπβ¦ObjMapβ¦β¦πβ¦βΊ Ξ·
by (rule assms(1))
interpret π: is_functor Ξ± π
βΉcat_1 π π£βΊ π by (rule assms(2))
interpret π: is_functor Ξ± βΉcat_1 π π£βΊ π π by (rule assms(3))
from cat_1_components(1) have π: "π ββ©β Vset Ξ±"
by (auto simp: π.HomCod.cat_in_Obj_in_Vset)
from cat_1_components(2) have π£: "π£ ββ©β Vset Ξ±"
by (auto simp: π.HomCod.cat_in_Arr_in_Vset)
have ππ: "πβ¦ObjMapβ¦β¦πβ¦ = op_cf πβ¦ObjMapβ¦β¦πβ¦" unfolding cat_op_simps by simp
note cat_1_op = Ξ·.cat_1_op[OF π π£]
show ?thesis
by
(
rule is_cat_rKe.is_cat_lKe_op
[
OF cat_limit_is_rKe
[
OF
Ξ·.is_cat_limit_op[unfolded ππ]
π.is_functor_op[unfolded cat_1_op]
π.is_functor_op[unfolded cat_1_op]
],
unfolded cat_op_simps cat_1_op
]
)
qed
subsubsectionβΉAdjointsβΊ
lemma (in is_cf_adjunction) cf_adjunction_counit_is_rKe:
shows "Ξ΅β©C Ξ¦ : π ββ©Cβ©F π β¦β©Cβ©Fβ©.β©rβ©Kβ©eβΞ±β cf_id π : π β¦β©C β β¦β©C π"
proof-
define Ξ² where "Ξ² = Ξ± + Ο"
have Ξ²: "π΅ Ξ²" and Ξ±Ξ²: "Ξ± ββ©β Ξ²"
by (simp_all add: Ξ²_def π΅_Limit_Ξ±Ο π΅_Ο_Ξ±Ο π΅_def π΅_Ξ±_Ξ±Ο)
then interpret Ξ²: π΅ Ξ² by simp
note exp_adj = cf_adj_exp_cf_cat_exp_cf_cat[OF Ξ² Ξ±Ξ² R.category_axioms]
let ?Ξ· = βΉΞ·β©C Ξ¦βΊ
let ?Ξ΅ = βΉΞ΅β©C Ξ¦βΊ
let ?πΞ· = βΉexp_cat_ntcf Ξ± π ?Ξ·βΊ
let ?ππ = βΉexp_cat_cf Ξ± π πβΊ
let ?ππ = βΉexp_cat_cf Ξ± π πβΊ
let ?ππ = βΉcat_FUNCT Ξ± π πβΊ
let ?βπ = βΉcat_FUNCT Ξ± β πβΊ
let ?adj_πΞ· = βΉcf_adjunction_of_unit Ξ² ?ππ ?ππ ?πΞ·βΊ
interpret πΞ·: is_cf_adjunction Ξ² ?βπ ?ππ ?ππ ?ππ ?adj_πΞ· by (rule exp_adj)
show ?thesis
proof(intro is_cat_rKeI)
have id_π: "cf_map (cf_id π) ββ©β cat_FUNCT Ξ± π πβ¦Objβ¦"
by
(
cs_concl
cs_simp: cat_FUNCT_components(1)
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
then have exp_id_π:
"exp_cat_cf Ξ± π πβ¦ObjMapβ¦β¦cf_map (cf_id π)β¦ = cf_map π"
by
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps cs_intro: cat_cs_intros
)
have π: "cf_map π ββ©β cat_FUNCT Ξ± β πβ¦Objβ¦"
by
(
cs_concl
cs_simp: cat_FUNCT_components(1)
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
have Ξ΅: "ntcf_arrow (Ξ΅β©C Ξ¦) ββ©β ntcf_arrows Ξ± π π"
by (cs_concl cs_intro: cat_FUNCT_cs_intros adj_cs_intros)
have ππ: "category Ξ² (cat_FUNCT Ξ± π π)"
by (cs_concl cs_intro: cat_cs_intros)
have βπ: "category Ξ² (cat_FUNCT Ξ± β π)"
by (cs_concl cs_intro: cat_cs_intros)
from
Ξ΅ π Ξ±Ξ² id_π
ππ βπ LR.is_functor_axioms RL.is_functor_axioms R.cat_cf_id_is_functor
NT.is_iso_ntcf_axioms
have Ξ΅_id_π: "Ξ΅β©C ?adj_πΞ·β¦NTMapβ¦β¦cf_map (cf_id π)β¦ = ntcf_arrow ?Ξ΅"
by
(
cs_concl
cs_simp:
cat_Set_the_inverse[symmetric]
cat_op_simps
cat_cs_simps
cat_FUNCT_cs_simps
adj_cs_simps
cs_intro:
πΞ·.NT.iso_ntcf_is_arr_isomorphism''
cat_op_intros
adj_cs_intros
cat_small_cs_intros
cat_cs_intros
cat_FUNCT_cs_intros
cat_prod_cs_intros
)
show "universal_arrow_fo ?ππ (cf_map (cf_id π)) (cf_map π) (ntcf_arrow ?Ξ΅)"
by
(
rule is_cf_adjunction.cf_adjunction_counit_component_is_ua_fo[
OF exp_adj id_π, unfolded exp_id_π Ξ΅_id_π
]
)
qed (cs_concl cs_intro: cat_cs_intros adj_cs_intros)+
qed
lemma (in is_cf_adjunction) cf_adjunction_unit_is_lKe:
shows "Ξ·β©C Ξ¦ : cf_id β β¦β©Cβ©Fβ©.β©lβ©Kβ©eβΞ±β π ββ©Cβ©F π : β β¦β©C π β¦β©C β"
by
(
rule is_cat_rKe.is_cat_lKe_op
[
OF is_cf_adjunction.cf_adjunction_counit_is_rKe
[
OF is_cf_adjunction_op,
folded op_ntcf_cf_adjunction_unit op_cf_cf_id
],
unfolded
cat_op_simps ntcf_op_ntcf_op_ntcf[OF cf_adjunction_unit_is_ntcf]
]
)
lemma cf_adjunction_if_lKe_preserves:
assumes "Ξ· : cf_id π β¦β©Cβ©Fβ©.β©lβ©Kβ©eβΞ±β π ββ©Cβ©F π : π β¦β©C β β¦β©C (π : π β¦β¦β©C β)"
shows "cf_adjunction_of_unit Ξ± π π Ξ· : π ββ©Cβ©F π : π βββ©CβΞ±β β"
proof-
interpret Ξ·: is_cat_lKe_preserves Ξ± π β π β π βΉcf_id πβΊ π π Ξ·
by (rule assms)
from Ξ·.cat_lKe_preserves interpret πΞ·:
is_cat_lKe Ξ± π β β π π βΉπ ββ©Cβ©F πβΊ βΉπ ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F Ξ·βΊ
by (cs_prems cs_simp: cat_cs_simps)
from
πΞ·.cat_lKe_unique
[
OF Ξ·.AG.HomCod.cat_cf_id_is_functor,
unfolded Ξ·.AG.cf_cf_comp_cf_id_left,
OF Ξ·.AG.cf_ntcf_id_is_ntcf
]
obtain Ξ΅ where Ξ΅: "Ξ΅ : π ββ©Cβ©F π β¦β©Cβ©F cf_id β : β β¦β¦β©CβΞ±β β"
and ntcf_id_π_def: "ntcf_id π = Ξ΅ ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π ββ©Nβ©Tβ©Cβ©F (π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F Ξ·)"
by metis
interpret Ξ΅: is_ntcf Ξ± β β βΉπ ββ©Cβ©F πβΊ βΉcf_id ββΊ Ξ΅ by (rule Ξ΅)
show ?thesis
proof(rule counit_unit_is_cf_adjunction)
show [cat_cs_simps]: "Ξ΅ ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π ββ©Nβ©Tβ©Cβ©F (π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F Ξ·) = ntcf_id π"
by (rule ntcf_id_π_def[symmetric])
have Ξ·_def: "Ξ· = (ntcf_id π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π) ββ©Nβ©Tβ©Cβ©F Ξ·"
by
(
cs_concl
cs_simp: cat_cs_simps ntcf_id_cf_comp[symmetric]
cs_intro: cat_cs_intros
)
note [cat_cs_simps] = this[symmetric]
let ?πΞ΅π = βΉπ ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F Ξ΅ ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F πβΊ
let ?Ξ·ππ = βΉΞ· ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F πβΊ
let ?ππΞ· = βΉπ ββ©Cβ©F π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F Ξ·βΊ
have "(?πΞ΅π ββ©Nβ©Tβ©Cβ©F ?Ξ·ππ) ββ©Nβ©Tβ©Cβ©F Ξ· = (?πΞ΅π ββ©Nβ©Tβ©Cβ©F ?ππΞ·) ββ©Nβ©Tβ©Cβ©F Ξ·"
proof(rule ntcf_eqI)
have dom_lhs: "πβ©β (((?πΞ΅π ββ©Nβ©Tβ©Cβ©F ?Ξ·ππ) ββ©Nβ©Tβ©Cβ©F Ξ·)β¦NTMapβ¦) = πβ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
have dom_rhs: "πβ©β (((?πΞ΅π ββ©Nβ©Tβ©Cβ©F ?ππΞ·) ββ©Nβ©Tβ©Cβ©F Ξ·)β¦NTMapβ¦) = πβ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
note is_ntcf.ntcf_Comp_commute[cat_cs_simps del]
note category.cat_Comp_assoc[cat_cs_simps del]
show
"((?πΞ΅π ββ©Nβ©Tβ©Cβ©F ?Ξ·ππ) ββ©Nβ©Tβ©Cβ©F Ξ·)β¦NTMapβ¦ =
((?πΞ΅π ββ©Nβ©Tβ©Cβ©F ?ππΞ·) ββ©Nβ©Tβ©Cβ©F Ξ·)β¦NTMapβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix a assume "a ββ©β πβ¦Objβ¦"
then show
"((?πΞ΅π ββ©Nβ©Tβ©Cβ©F ?Ξ·ππ) ββ©Nβ©Tβ©Cβ©F Ξ·)β¦NTMapβ¦β¦aβ¦ =
((?πΞ΅π ββ©Nβ©Tβ©Cβ©F ?ππΞ·) ββ©Nβ©Tβ©Cβ©F Ξ·)β¦NTMapβ¦β¦aβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps Ξ·.ntcf_lKe.ntcf_Comp_commute[symmetric]
cs_intro: cat_cs_intros
)
qed (cs_concl cs_intro: cat_cs_intros)+
qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
also have "β¦ = (ntcf_id π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π) ββ©Nβ©Tβ©Cβ©F Ξ·"
by
(
cs_concl
cs_simp:
cat_cs_simps
cf_comp_cf_ntcf_comp_assoc
cf_ntcf_comp_ntcf_cf_comp_assoc
cf_ntcf_comp_ntcf_vcomp[symmetric]
cs_intro: cat_cs_intros
)
also have "β¦ = Ξ·" by (cs_concl cs_simp: cat_cs_simps)
finally have "(?πΞ΅π ββ©Nβ©Tβ©Cβ©F ?Ξ·ππ) ββ©Nβ©Tβ©Cβ©F Ξ· = Ξ·" by simp
then have Ξ·_def':
"Ξ· = (π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F Ξ΅ ββ©Nβ©Tβ©Cβ©F (Ξ· ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π) ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π) ββ©Nβ©Tβ©Cβ©F Ξ·"
by
(
cs_concl
cs_simp: cat_cs_simps ntcf_vcomp_ntcf_cf_comp[symmetric]
cs_intro: cat_cs_intros
)+
have πΡηπ:
"π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F Ξ΅ ββ©Nβ©Tβ©Cβ©F (Ξ· ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π) : π β¦β©Cβ©F π : β β¦β¦β©CβΞ±β π"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from Ξ·.cat_lKe_unique[OF Ξ·.Lan.is_functor_axioms Ξ·.ntcf_lKe.is_ntcf_axioms]
obtain Ο where
"β¦ Ο' : π β¦β©Cβ©F π : β β¦β¦β©CβΞ±β π; Ξ· = Ο' ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π ββ©Nβ©Tβ©Cβ©F Ξ· β§ βΉ
Ο' = Ο"
for Ο'
by metis
from this[OF Ξ·.Lan.cf_ntcf_id_is_ntcf Ξ·_def] this[OF πΡηπ Ξ·_def'] show
"π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F Ξ΅ ββ©Nβ©Tβ©Cβ©F (Ξ· ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π) = ntcf_id π"
by simp
qed (cs_concl cs_intro: cat_cs_intros)+
qed
lemma cf_adjunction_if_rKe_preserves:
assumes "Ξ΅ : π ββ©Cβ©F π β¦β©Cβ©Fβ©.β©rβ©Kβ©eβΞ±β cf_id π : π β¦β©C β β¦β©C (π : π β¦β¦β©C β)"
shows "cf_adjunction_of_counit Ξ± π π Ξ΅ : π ββ©Cβ©F π : β βββ©CβΞ±β π"
proof-
interpret Ξ΅: is_cat_rKe_preserves Ξ± π β π β π βΉcf_id πβΊ π π Ξ΅
by (rule assms)
have "op_cf (cf_id π) = cf_id (op_cat π)" unfolding cat_op_simps by simp
show ?thesis
by
(
rule is_cf_adjunction.is_cf_adjunction_op
[
OF cf_adjunction_if_lKe_preserves[
OF Ξ΅.is_cat_rKe_preserves_op[unfolded op_cf_cf_id]
],
folded cf_adjunction_of_counit_def,
unfolded cat_op_simps
]
)
qed
textβΉ\newpageβΊ
endTheory CZH_UCAT_PWKan
sectionβΉPointwise Kan extensionsβΊ
theory CZH_UCAT_PWKan
imports CZH_UCAT_Kan
begin
subsectionβΉPointwise Kan extensionsβΊ
textβΉ
The following subsection is based on elements of the
content of section 6.3 in \cite{riehl_category_2016} and
Chapter X-5 in \cite{mac_lane_categories_2010}.
βΊ
locale is_cat_pw_rKe = is_cat_rKe Ξ± π
β π π π π Ξ΅
for Ξ± π
β π π π π Ξ΅ +
assumes cat_pw_rKe_preserved: "a ββ©β πβ¦Objβ¦ βΉ
Ξ΅ :
π ββ©Cβ©F π β¦β©Cβ©Fβ©.β©rβ©Kβ©eβΞ±β π :
π
β¦β©C β β¦β©C (Homβ©Oβ©.β©CβΞ±βπ(a,-) : π β¦β¦β©C cat_Set Ξ±)"
syntax "_is_cat_pw_rKe" :: "V β V β V β V β V β V β V β V β bool"
(
βΉ(_ :/ _ ββ©Cβ©F _ β¦β©Cβ©Fβ©.β©rβ©Kβ©eβ©.β©pβ©wΔ± _ :/ _ β¦β©C _ β¦β©C _)βΊ
[51, 51, 51, 51, 51, 51, 51] 51
)
translations "Ξ΅ : π ββ©Cβ©F π β¦β©Cβ©Fβ©.β©rβ©Kβ©eβ©.β©pβ©wβΞ±β π : π
β¦β©C β β¦β©C π" β
"CONST is_cat_pw_rKe Ξ± π
β π π π π Ξ΅"
locale is_cat_pw_lKe = is_cat_lKe Ξ± π
β π π π π Ξ·
for Ξ± π
β π π π π Ξ· +
assumes cat_pw_lKe_preserved: "a ββ©β op_cat πβ¦Objβ¦ βΉ
op_ntcf Ξ· :
op_cf π ββ©Cβ©F op_cf π β¦β©Cβ©Fβ©.β©rβ©Kβ©eβΞ±β op_cf π :
op_cat π
β¦β©C op_cat β β¦β©C (Homβ©Oβ©.β©CβΞ±βπ(-,a) : op_cat π β¦β¦β©C cat_Set Ξ±)"
syntax "_is_cat_pw_lKe" :: "V β V β V β V β V β V β V β V β bool"
(
βΉ(_ :/ _ β¦β©Cβ©Fβ©.β©lβ©Kβ©eβ©.β©pβ©wΔ± _ ββ©Cβ©F _ :/ _ β¦β©C _ β¦β©C _)βΊ
[51, 51, 51, 51, 51, 51, 51] 51
)
translations "Ξ· : π β¦β©Cβ©Fβ©.β©lβ©Kβ©eβ©.β©pβ©wβΞ±β π ββ©Cβ©F π : π
β¦β©C β β¦β©C π" β
"CONST is_cat_pw_lKe Ξ± π
β π π π π Ξ·"
lemma (in is_cat_pw_rKe) cat_pw_rKe_preserved'[cat_Kan_cs_intros]:
assumes "a ββ©β πβ¦Objβ¦"
and "π' = π"
and "β' = Homβ©Oβ©.β©CβΞ±βπ(a,-)"
and "π' = cat_Set Ξ±"
shows "Ξ΅ : π ββ©Cβ©F π β¦β©Cβ©Fβ©.β©rβ©Kβ©eβΞ±β π : π
β¦β©C β β¦β©C (β' : π' β¦β¦β©C π')"
using assms(1) unfolding assms(2-4) by (rule cat_pw_rKe_preserved)
lemmas [cat_Kan_cs_intros] = is_cat_pw_rKe.cat_pw_rKe_preserved'
lemma (in is_cat_pw_lKe) cat_pw_lKe_preserved'[cat_Kan_cs_intros]:
assumes "a ββ©β op_cat πβ¦Objβ¦"
and "π' = op_cf π"
and "π' = op_cf π"
and "π' = op_cf π"
and "π
' = op_cat π
"
and "β' = op_cat β"
and "π' = op_cat π"
and "β' = Homβ©Oβ©.β©CβΞ±βπ(-,a)"
and "π' = cat_Set Ξ±"
shows "op_ntcf Ξ· :
π' ββ©Cβ©F π' β¦β©Cβ©Fβ©.β©rβ©Kβ©eβΞ±β π' : π
' β¦β©C β' β¦β©C (β' : π' β¦β¦β©C π')"
using assms(1) unfolding assms by (rule cat_pw_lKe_preserved)
lemmas [cat_Kan_cs_intros] = is_cat_pw_lKe.cat_pw_lKe_preserved'
textβΉRules.βΊ
lemma (in is_cat_pw_rKe) is_cat_pw_rKe_axioms'[cat_Kan_cs_intros]:
assumes "Ξ±' = Ξ±"
and "π' = π"
and "π' = π"
and "π' = π"
and "π
' = π
"
and "π' = π"
and "β' = β"
shows "Ξ΅ : π' ββ©Cβ©F π' β¦β©Cβ©Fβ©.β©rβ©Kβ©eβ©.β©pβ©wβΞ±'β π' : π
' β¦β©C β' β¦β©C π'"
unfolding assms by (rule is_cat_pw_rKe_axioms)
mk_ide rf is_cat_pw_rKe_def[unfolded is_cat_pw_rKe_axioms_def]
|intro is_cat_pw_rKeI|
|dest is_cat_pw_rKeD[dest]|
|elim is_cat_pw_rKeE[elim]|
lemmas [cat_Kan_cs_intros] = is_cat_pw_rKeD(1)
lemma (in is_cat_pw_lKe) is_cat_pw_lKe_axioms'[cat_Kan_cs_intros]:
assumes "Ξ±' = Ξ±"
and "π' = π"
and "π' = π"
and "π' = π"
and "π
' = π
"
and "π' = π"
and "β' = β"
shows "Ξ· : π' β¦β©Cβ©Fβ©.β©lβ©Kβ©eβ©.β©pβ©wβΞ±'β π' ββ©Cβ©F π' : π
' β¦β©C β' β¦β©C π'"
unfolding assms by (rule is_cat_pw_lKe_axioms)
mk_ide rf is_cat_pw_lKe_def[unfolded is_cat_pw_lKe_axioms_def]
|intro is_cat_pw_lKeI|
|dest is_cat_pw_lKeD[dest]|
|elim is_cat_pw_lKeE[elim]|
lemmas [cat_Kan_cs_intros] = is_cat_pw_lKeD(1)
textβΉDuality.βΊ
lemma (in is_cat_pw_rKe) is_cat_pw_lKe_op:
"op_ntcf Ξ΅ :
op_cf π β¦β©Cβ©Fβ©.β©lβ©Kβ©eβ©.β©pβ©wβΞ±β op_cf π ββ©Cβ©F op_cf π :
op_cat π
β¦β©C op_cat β β¦β©C op_cat π"
proof(intro is_cat_pw_lKeI, unfold cat_op_simps)
fix a assume prems: "a ββ©β πβ¦Objβ¦"
from cat_pw_rKe_preserved[OF prems] prems show
"Ξ΅ :
π ββ©Cβ©F π β¦β©Cβ©Fβ©.β©rβ©Kβ©eβΞ±β π :
π
β¦β©C β β¦β©C (Homβ©Oβ©.β©CβΞ±βop_cat π(-,a) : π β¦β¦β©C cat_Set Ξ±)"
by (cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros)
qed (cs_concl cs_intro: cat_op_intros)
lemma (in is_cat_pw_rKe) is_cat_pw_lKe_op'[cat_op_intros]:
assumes "π' = op_cf π"
and "π' = op_cf π"
and "π' = op_cf π"
and "π
' = op_cat π
"
and "π' = op_cat π"
and "β' = op_cat β"
shows "op_ntcf Ξ΅ : π' β¦β©Cβ©Fβ©.β©lβ©Kβ©eβ©.β©pβ©wβΞ±β π' ββ©Cβ©F π' : π
' β¦β©C β' β¦β©C π'"
unfolding assms by (rule is_cat_pw_lKe_op)
lemmas [cat_op_intros] = is_cat_pw_rKe.is_cat_pw_lKe_op'
lemma (in is_cat_pw_lKe) is_cat_pw_rKe_op:
"op_ntcf Ξ· :
op_cf π ββ©Cβ©F op_cf π β¦β©Cβ©Fβ©.β©rβ©Kβ©eβ©.β©pβ©wβΞ±β op_cf π :
op_cat π
β¦β©C op_cat β β¦β©C op_cat π"
proof(intro is_cat_pw_rKeI, unfold cat_op_simps)
fix a assume prems: "a ββ©β πβ¦Objβ¦"
from cat_pw_lKe_preserved[unfolded cat_op_simps, OF prems] prems show
"op_ntcf Ξ· :
op_cf π ββ©Cβ©F op_cf π β¦β©Cβ©Fβ©.β©rβ©Kβ©eβΞ±β op_cf π :
op_cat π
β¦β©C op_cat β β¦β©C
(Homβ©Oβ©.β©CβΞ±βop_cat π(a,-) : op_cat π β¦β¦β©C cat_Set Ξ±)"
by (cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros)
qed (cs_concl cs_intro: cat_op_intros)
lemma (in is_cat_pw_lKe) is_cat_pw_lKe_op'[cat_op_intros]:
assumes "π' = op_cf π"
and "π' = op_cf π"
and "π' = op_cf π"
and "π
' = op_cat π
"
and "π' = op_cat π"
and "β' = op_cat β"
shows "op_ntcf Ξ· : π' ββ©Cβ©F π' β¦β©Cβ©Fβ©.β©rβ©Kβ©eβ©.β©pβ©wβΞ±β π' : π
' β¦β©C β' β¦β©C π'"
unfolding assms by (rule is_cat_pw_rKe_op)
lemmas [cat_op_intros] = is_cat_pw_lKe.is_cat_pw_lKe_op'
subsectionβΉCone functorβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition cf_Cone :: "V β V β V β V"
where "cf_Cone Ξ± Ξ² π =
Homβ©Oβ©.β©CβΞ²βcat_Funct Ξ± (πβ¦HomDomβ¦) (πβ¦HomCodβ¦)(-,cf_map π) ββ©Cβ©F
op_cf (Ξβ©C Ξ± (πβ¦HomDomβ¦) (πβ¦HomCodβ¦))"
textβΉAn alternative form of the definition.βΊ
context is_functor
begin
lemma cf_Cone_def':
"cf_Cone Ξ± Ξ² π = Homβ©Oβ©.β©CβΞ²βcat_Funct Ξ± π π
(-,cf_map π) ββ©Cβ©F op_cf (Ξβ©C Ξ± π π
)"
unfolding cf_Cone_def cat_cs_simps by simp
end
subsubsectionβΉObject mapβΊ
lemma (in is_tm_functor) cf_Cone_ObjMap_vsv[cat_Kan_cs_intros]:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²"
shows "vsv (cf_Cone Ξ± Ξ² πβ¦ObjMapβ¦)"
proof-
from assms interpret Ξ²: π΅ Ξ² by simp
from assms interpret Ξ: is_functor Ξ± π
βΉcat_Funct Ξ± π π
βΊ βΉΞβ©C Ξ± π π
βΊ
by
(
cs_concl cs_intro:
cat_small_cs_intros cat_cs_intros cat_op_intros
)+
from Ξ.is_functor_axioms assms(2) interpret Ξ²Ξ:
is_functor Ξ² π
βΉcat_Funct Ξ± π π
βΊ βΉΞβ©C Ξ± π π
βΊ
by (cs_intro_step is_functor.cf_is_functor_if_ge_Limit)
(cs_concl cs_intro: cat_cs_intros)+
from assms(2) show ?thesis
unfolding cf_Cone_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_Funct_components(1) cat_op_simps
cs_intro:
cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
)
qed
lemmas [cat_Kan_cs_intros] = is_tm_functor.cf_Cone_ObjMap_vsv
lemma (in is_tm_functor) cf_Cone_ObjMap_vdomain[cat_Kan_cs_simps]:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²" and "b ββ©β π
β¦Objβ¦"
shows "πβ©β (cf_Cone Ξ± Ξ² πβ¦ObjMapβ¦) = π
β¦Objβ¦"
proof-
from assms interpret Ξ²: π΅ Ξ² by simp
from assms interpret Ξ: is_functor Ξ± π
βΉcat_Funct Ξ± π π
βΊ βΉΞβ©C Ξ± π π
βΊ
by
(
cs_concl cs_intro:
cat_small_cs_intros cat_cs_intros cat_op_intros
)+
from Ξ.is_functor_axioms assms(2) interpret Ξ²Ξ:
is_functor Ξ² π
βΉcat_Funct Ξ± π π
βΊ βΉΞβ©C Ξ± π π
βΊ
by (cs_intro_step is_functor.cf_is_functor_if_ge_Limit)
(cs_concl cs_intro: cat_cs_intros)+
from assms(2) show ?thesis
unfolding cf_Cone_def'
by
(
cs_concl
cs_simp: cat_cs_simps cat_Funct_components(1) cat_op_simps
cs_intro:
cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
)
qed
lemmas [cat_Kan_cs_simps] = is_tm_functor.cf_Cone_ObjMap_vdomain
lemma (in is_tm_functor) cf_Cone_ObjMap_app[cat_Kan_cs_simps]:
assumes "π΅ Ξ²"
and "Ξ± ββ©β Ξ²"
and "b ββ©β π
β¦Objβ¦"
shows "cf_Cone Ξ± Ξ² πβ¦ObjMapβ¦β¦bβ¦ =
Hom (cat_Funct Ξ± π π
) (cf_map (cf_const π π
b)) (cf_map π)"
proof-
from assms interpret Ξ²: π΅ Ξ² by simp
from assms interpret Ξ: is_functor Ξ± π
βΉcat_Funct Ξ± π π
βΊ βΉΞβ©C Ξ± π π
βΊ
by
(
cs_concl cs_intro:
cat_small_cs_intros cat_cs_intros cat_op_intros
)+
from Ξ.is_functor_axioms assms(2) interpret Ξ²Ξ:
is_functor Ξ² π
βΉcat_Funct Ξ± π π
βΊ βΉΞβ©C Ξ± π π
βΊ
by (cs_intro_step is_functor.cf_is_functor_if_ge_Limit)
(cs_concl cs_intro: cat_cs_intros)+
from assms(2,3) show ?thesis
unfolding cf_Cone_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_Funct_components(1) cat_op_simps
cs_intro:
cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
)
qed
lemmas [cat_Kan_cs_simps] = is_tm_functor.cf_Cone_ObjMap_app
subsubsectionβΉArrow mapβΊ
lemma (in is_tm_functor) cf_Cone_ArrMap_vsv[cat_Kan_cs_intros]:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²"
shows "vsv (cf_Cone Ξ± Ξ² πβ¦ArrMapβ¦)"
proof-
from assms interpret Ξ²: π΅ Ξ² by simp
from assms interpret Ξ: is_functor Ξ± π
βΉcat_Funct Ξ± π π
βΊ βΉΞβ©C Ξ± π π
βΊ
by
(
cs_concl cs_intro:
cat_small_cs_intros cat_cs_intros cat_op_intros
)+
from Ξ.is_functor_axioms assms(2) interpret Ξ²Ξ:
is_functor Ξ² π
βΉcat_Funct Ξ± π π
βΊ βΉΞβ©C Ξ± π π
βΊ
by (cs_intro_step is_functor.cf_is_functor_if_ge_Limit)
(cs_concl cs_intro: cat_cs_intros)+
from assms(2) show ?thesis
unfolding cf_Cone_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_Funct_components(1) cat_op_simps
cs_intro:
cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
)
qed
lemmas [cat_Kan_cs_intros] = is_tm_functor.cf_Cone_ArrMap_vsv
lemma (in is_tm_functor) cf_Cone_ArrMap_vdomain[cat_Kan_cs_simps]:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²" and "b ββ©β π
β¦Objβ¦"
shows "πβ©β (cf_Cone Ξ± Ξ² πβ¦ArrMapβ¦) = π
β¦Arrβ¦"
proof-
from assms interpret Ξ²: π΅ Ξ² by simp
from assms interpret Ξ: is_functor Ξ± π
βΉcat_Funct Ξ± π π
βΊ βΉΞβ©C Ξ± π π
βΊ
by
(
cs_concl cs_intro:
cat_small_cs_intros cat_cs_intros cat_op_intros
)+
from Ξ.is_functor_axioms assms(2) interpret Ξ²Ξ:
is_functor Ξ² π
βΉcat_Funct Ξ± π π
βΊ βΉΞβ©C Ξ± π π
βΊ
by (cs_intro_step is_functor.cf_is_functor_if_ge_Limit)
(cs_concl cs_intro: cat_cs_intros)+
from assms(2) show ?thesis
unfolding cf_Cone_def'
by
(
cs_concl
cs_simp: cat_cs_simps cat_Funct_components(1) cat_op_simps
cs_intro:
cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
)
qed
lemmas [cat_Kan_cs_simps] = is_tm_functor.cf_Cone_ArrMap_vdomain
lemma (in is_tm_functor) cf_Cone_ArrMap_app[cat_Kan_cs_simps]:
assumes "π΅ Ξ²"
and "Ξ± ββ©β Ξ²"
and "f : a β¦βπ
β b"
shows "cf_Cone Ξ± Ξ² πβ¦ArrMapβ¦β¦fβ¦ = cf_hom
(cat_Funct Ξ± π π
)
[ntcf_arrow (ntcf_const π π
f), cat_Funct Ξ± π π
β¦CIdβ¦β¦cf_map πβ¦]β©β"
proof-
from assms interpret Ξ²: π΅ Ξ² by simp
from assms interpret Ξ: is_functor Ξ± π
βΉcat_Funct Ξ± π π
βΊ βΉΞβ©C Ξ± π π
βΊ
by
(
cs_concl cs_intro:
cat_small_cs_intros cat_cs_intros cat_op_intros
)+
from Ξ.is_functor_axioms assms(2) interpret Ξ²Ξ:
is_functor Ξ² π
βΉcat_Funct Ξ± π π
βΊ βΉΞβ©C Ξ± π π
βΊ
by (cs_intro_step is_functor.cf_is_functor_if_ge_Limit)
(cs_concl cs_intro: cat_cs_intros)+
from assms(2,3) show ?thesis
unfolding cf_Cone_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_Funct_components(1) cat_op_simps
cs_intro:
cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
)
qed
lemmas [cat_Kan_cs_simps] = is_tm_functor.cf_Cone_ArrMap_app
subsubsectionβΉThe cone functor is a functorβΊ
lemma (in is_tm_functor) tm_cf_cf_Cone_is_functor:
"cf_Cone Ξ± Ξ± π : op_cat π
β¦β¦β©CβΞ±β cat_Set Ξ±"
unfolding cf_Cone_def'
by
(
cs_concl
cs_simp: cat_op_simps cat_Funct_components(1)
cs_intro:
cat_small_cs_intros
cat_cs_intros
cat_FUNCT_cs_intros
cat_op_intros
)
lemma (in is_tm_functor) tm_cf_cf_Cone_is_functor_if_ge_Limit:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²"
shows "cf_Cone Ξ± Ξ² π : op_cat π
β¦β¦β©CβΞ²β cat_Set Ξ²"
proof-
from assms interpret ππ
: category Ξ± βΉcat_Funct Ξ± π π
βΊ
by
(
cs_concl cs_intro:
cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
interpret Ξ²_ππ
: category Ξ² βΉcat_Funct Ξ± π π
βΊ
by (rule ππ
.cat_category_if_ge_Limit)
(cs_concl cs_intro: cat_cs_intros assms)+
from assms interpret op_Ξ:
is_tiny_functor Ξ² βΉop_cat π
βΊ βΉop_cat (cat_Funct Ξ± π π
)βΊ βΉop_cf (Ξβ©C Ξ± π π
)βΊ
by (intro is_functor.cf_is_tiny_functor_if_ge_Limit)
(
cs_concl cs_intro:
cat_small_cs_intros cat_cs_intros cat_op_intros
)+
have "Homβ©Oβ©.β©CβΞ²βcat_Funct Ξ± π π
(-,cf_map π) :
op_cat (cat_Funct Ξ± π π
) β¦β¦β©CβΞ²β cat_Set Ξ²"
by
(
cs_concl
cs_simp: cat_Funct_components(1)
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
then show "cf_Cone Ξ± Ξ² π : op_cat π
β¦β¦β©CβΞ²β cat_Set Ξ²"
unfolding cf_Cone_def'
by (cs_concl cs_intro: cat_cs_intros)
qed
subsectionβΉLemma X.5: βΉL_10_5_NβΊ\label{sec:lem_X_5_start}βΊ
textβΉ
This subsection and several further subsections
(\ref{sec:lem_X_5_start}-\ref{sec:lem_X_5_end})
expose definitions that are used in the proof of the technical lemma that
was used in the proof of Theorem 3 from Chapter X-5
in \cite{mac_lane_categories_2010}.
βΊ
definition L_10_5_N :: "V β V β V β V β V β V"
where "L_10_5_N Ξ± Ξ² π π c =
[
(
Ξ»aββ©βπβ¦HomCodβ¦β¦Objβ¦.
cf_nt Ξ± Ξ² πβ¦ObjMapβ¦β¦cf_map (Homβ©Oβ©.β©CβΞ±βπβ¦HomCodβ¦(a,-) ββ©Cβ©F π), cβ¦β©β
),
(
Ξ»fββ©βπβ¦HomCodβ¦β¦Arrβ¦.
cf_nt Ξ± Ξ² πβ¦ArrMapβ¦β¦
ntcf_arrow (Homβ©Aβ©.β©CβΞ±βπβ¦HomCodβ¦(f,-) ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π), πβ¦HomCodβ¦β¦CIdβ¦β¦cβ¦
β¦β©β
),
op_cat (πβ¦HomCodβ¦),
cat_Set Ξ²
]β©β"
textβΉComponents.βΊ
lemma L_10_5_N_components:
shows "L_10_5_N Ξ± Ξ² π π cβ¦ObjMapβ¦ =
(
Ξ»aββ©βπβ¦HomCodβ¦β¦Objβ¦.
cf_nt Ξ± Ξ² πβ¦ObjMapβ¦β¦cf_map (Homβ©Oβ©.β©CβΞ±βπβ¦HomCodβ¦(a,-) ββ©Cβ©F π), cβ¦β©β
)"
and "L_10_5_N Ξ± Ξ² π π cβ¦ArrMapβ¦ =
(
Ξ»fββ©βπβ¦HomCodβ¦β¦Arrβ¦.
cf_nt Ξ± Ξ² πβ¦ArrMapβ¦β¦
ntcf_arrow (Homβ©Aβ©.β©CβΞ±βπβ¦HomCodβ¦(f,-) ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π), πβ¦HomCodβ¦β¦CIdβ¦β¦cβ¦
β¦β©β
)"
and "L_10_5_N Ξ± Ξ² π π cβ¦HomDomβ¦ = op_cat (πβ¦HomCodβ¦)"
and "L_10_5_N Ξ± Ξ² π π cβ¦HomCodβ¦ = cat_Set Ξ²"
unfolding L_10_5_N_def dghm_field_simps by (simp_all add: nat_omega_simps)
context
fixes Ξ± π
β π π π
assumes π: "π : π
β¦β¦β©CβΞ±β β"
and π: "π : π
β¦β¦β©CβΞ±β π"
begin
interpretation π: is_functor Ξ± π
β π by (rule π)
interpretation π: is_functor Ξ± π
π π by (rule π)
lemmas L_10_5_N_components' = L_10_5_N_components[
where π=π and π=π, unfolded cat_cs_simps
]
lemmas [cat_Kan_cs_simps] = L_10_5_N_components'(3,4)
end
subsubsectionβΉObject mapβΊ
mk_VLambda L_10_5_N_components(1)
|vsv L_10_5_N_ObjMap_vsv[cat_Kan_cs_intros]|
context
fixes Ξ± π
β π π π c
assumes π: "π : π
β¦β¦β©CβΞ±β β"
and π: "π : π
β¦β¦β©CβΞ±β π"
begin
mk_VLambda L_10_5_N_components'(1)[OF π π]
|vdomain L_10_5_N_ObjMap_vdomain[cat_Kan_cs_simps]|
|app L_10_5_N_ObjMap_app[cat_Kan_cs_simps]|
end
subsubsectionβΉArrow mapβΊ
mk_VLambda L_10_5_N_components(2)
|vsv L_10_5_N_ArrMap_vsv[cat_Kan_cs_intros]|
context
fixes Ξ± π
β π π π c
assumes π: "π : π
β¦β¦β©CβΞ±β β"
and π: "π : π
β¦β¦β©CβΞ±β π"
begin
mk_VLambda L_10_5_N_components'(2)[OF π π]
|vdomain L_10_5_N_ArrMap_vdomain[cat_Kan_cs_simps]|
|app L_10_5_N_ArrMap_app[cat_Kan_cs_simps]|
end
subsubsectionβΉβΉL_10_5_NβΊ is a functorβΊ
lemma L_10_5_N_is_functor:
assumes "π΅ Ξ²"
and "Ξ± ββ©β Ξ²"
and "π : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
and "π : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β π"
and "c ββ©β ββ¦Objβ¦"
shows "L_10_5_N Ξ± Ξ² π π c : op_cat π β¦β¦β©CβΞ²β cat_Set Ξ²"
proof-
let ?FUNCT = βΉΞ»π. cat_FUNCT Ξ± π (cat_Set Ξ±)βΊ
interpret Ξ²: π΅ Ξ² by (rule assms(1))
interpret π: is_tm_functor Ξ± π
β π by (rule assms(3))
interpret π: is_tm_functor Ξ± π
π π by (rule assms(4))
from assms(2) interpret FUNCT_π
: tiny_category Ξ² βΉ?FUNCT π
βΊ
by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
interpret Ξ²π: is_tiny_functor Ξ² π
β π
by (rule is_functor.cf_is_tiny_functor_if_ge_Limit)
(use assms(2) in βΉcs_concl cs_intro: cat_cs_introsβΊ)+
interpret Ξ²π: is_tiny_functor Ξ² π
π π
by (rule is_functor.cf_is_tiny_functor_if_ge_Limit)
(use assms(2) in βΉcs_concl cs_intro: cat_cs_introsβΊ)+
from assms(2) interpret cf_nt:
is_functor Ξ² βΉ?FUNCT π
Γβ©C ββΊ βΉcat_Set Ξ²βΊ βΉcf_nt Ξ± Ξ² πβΊ
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show ?thesis
proof(intro is_functorI')
show "vfsequence (L_10_5_N Ξ± Ξ² π π c)" unfolding L_10_5_N_def by simp
show "vcard (L_10_5_N Ξ± Ξ² π π c) = 4β©β"
unfolding L_10_5_N_def by (simp add: nat_omega_simps)
show "vsv (L_10_5_N Ξ± Ξ² π π cβ¦ObjMapβ¦)"
by (cs_concl cs_intro: cat_Kan_cs_intros)
from assms(3,4) show "vsv (L_10_5_N Ξ± Ξ² π π cβ¦ArrMapβ¦)"
by (cs_concl cs_intro: cat_Kan_cs_intros)
from assms show "πβ©β (L_10_5_N Ξ± Ξ² π π cβ¦ObjMapβ¦) = op_cat πβ¦Objβ¦"
by
(
cs_concl
cs_simp: cat_Kan_cs_simps cat_op_simps cs_intro: cat_cs_intros
)
show "ββ©β (L_10_5_N Ξ± Ξ² π π cβ¦ObjMapβ¦) ββ©β cat_Set Ξ²β¦Objβ¦"
unfolding L_10_5_N_components'[OF π.is_functor_axioms π.is_functor_axioms]
proof(rule vrange_VLambda_vsubset)
fix a assume prems: "a ββ©β πβ¦Objβ¦"
from prems assms show
"cf_nt Ξ± Ξ² πβ¦ObjMapβ¦β¦cf_map (Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F π), cβ¦β©β ββ©β
cat_Set Ξ²β¦Objβ¦"
by
(
cs_concl
cs_simp: cat_Set_components(1) cat_cs_simps cat_FUNCT_cs_simps
cs_intro:
cat_cs_intros FUNCT_π
.cat_Hom_in_Vset cat_FUNCT_cs_intros
)
qed
from assms show "πβ©β (L_10_5_N Ξ± Ξ² π π cβ¦ArrMapβ¦) = op_cat πβ¦Arrβ¦"
by
(
cs_concl
cs_simp: cat_Kan_cs_simps cat_op_simps cs_intro: cat_cs_intros
)
show "L_10_5_N Ξ± Ξ² π π cβ¦ArrMapβ¦β¦fβ¦ :
L_10_5_N Ξ± Ξ² π π cβ¦ObjMapβ¦β¦aβ¦ β¦βcat_Set Ξ²β L_10_5_N Ξ± Ξ² π π cβ¦ObjMapβ¦β¦bβ¦"
if "f : a β¦βop_cat πβ b" for a b f
using that assms
unfolding cat_op_simps
by
(
cs_concl
cs_simp: L_10_5_N_ArrMap_app L_10_5_N_ObjMap_app
cs_intro: cat_cs_intros cat_prod_cs_intros cat_FUNCT_cs_intros
)
show
"L_10_5_N Ξ± Ξ² π π cβ¦ArrMapβ¦β¦g ββ©Aβop_cat πβ fβ¦ =
L_10_5_N Ξ± Ξ² π π cβ¦ArrMapβ¦β¦gβ¦ ββ©Aβcat_Set Ξ²β L_10_5_N Ξ± Ξ² π π cβ¦ArrMapβ¦β¦fβ¦"
if "g : b' β¦βop_cat πβ c'" and "f : a' β¦βop_cat πβ b'" for b' c' g a' f
proof-
from that assms(5) show ?thesis
unfolding cat_op_simps
by
(
cs_concl
cs_intro:
cat_cs_intros
cat_prod_cs_intros
cat_FUNCT_cs_intros
cat_op_intros
cs_simp:
cat_cs_simps
cat_Kan_cs_simps
cat_FUNCT_cs_simps
cat_prod_cs_simps
cat_op_simps
cf_nt.cf_ArrMap_Comp[symmetric]
)
qed
show
"L_10_5_N Ξ± Ξ² π π cβ¦ArrMapβ¦β¦op_cat πβ¦CIdβ¦β¦aβ¦β¦ =
cat_Set Ξ²β¦CIdβ¦β¦L_10_5_N Ξ± Ξ² π π cβ¦ObjMapβ¦β¦aβ¦β¦"
if "a ββ©β op_cat πβ¦Objβ¦" for a
proof-
note [cat_cs_simps] =
ntcf_id_cf_comp[symmetric]
ntcf_arrow_id_ntcf_id[symmetric]
cat_FUNCT_CId_app[symmetric]
from that[unfolded cat_op_simps] assms show ?thesis
by
(
cs_concl
cs_intro:
cat_cs_intros
cat_FUNCT_cs_intros
cat_prod_cs_intros
cat_op_intros
cs_simp:
cat_FUNCT_cs_simps cat_cs_simps cat_Kan_cs_simps cat_op_simps
)
qed
qed (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)+
qed
lemma L_10_5_N_is_functor'[cat_Kan_cs_intros]:
assumes "π΅ Ξ²"
and "Ξ± ββ©β Ξ²"
and "π : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
and "π : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β π"
and "c ββ©β ββ¦Objβ¦"
and "π' = op_cat π"
and "π
' = cat_Set Ξ²"
and "Ξ²' = Ξ²"
shows "L_10_5_N Ξ± Ξ² π π c : π' β¦β¦β©CβΞ²'β π
'"
using assms(1-5) unfolding assms(6-8) by (rule L_10_5_N_is_functor)
subsectionβΉLemma X.5: βΉL_10_5_Ο
_arrowβΊβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition L_10_5_Ο
_arrow :: "V β V β V β V β V β V β V"
where "L_10_5_Ο
_arrow π π c Ο a b =
[
(Ξ»fββ©βHom (πβ¦HomCodβ¦) c (πβ¦ObjMapβ¦β¦bβ¦). Οβ¦NTMapβ¦β¦0, b, fβ¦β©β),
Hom (πβ¦HomCodβ¦) c (πβ¦ObjMapβ¦β¦bβ¦),
Hom (πβ¦HomCodβ¦) a (πβ¦ObjMapβ¦β¦bβ¦)
]β©β"
textβΉComponents.βΊ
lemma L_10_5_Ο
_arrow_components:
shows "L_10_5_Ο
_arrow π π c Ο a bβ¦ArrValβ¦ =
(Ξ»fββ©βHom (πβ¦HomCodβ¦) c (πβ¦ObjMapβ¦β¦bβ¦). Οβ¦NTMapβ¦β¦0, b, fβ¦β©β)"
and "L_10_5_Ο
_arrow π π c Ο a bβ¦ArrDomβ¦ = Hom (πβ¦HomCodβ¦) c (πβ¦ObjMapβ¦β¦bβ¦)"
and "L_10_5_Ο
_arrow π π c Ο a bβ¦ArrCodβ¦ = Hom (πβ¦HomCodβ¦) a (πβ¦ObjMapβ¦β¦bβ¦)"
unfolding L_10_5_Ο
_arrow_def arr_field_simps
by (simp_all add: nat_omega_simps)
context
fixes Ξ± π
β π π π
assumes π: "π : π
β¦β¦β©CβΞ±β β"
and π: "π : π
β¦β¦β©CβΞ±β π"
begin
interpretation π: is_functor Ξ± π
β π by (rule π)
interpretation π: is_functor Ξ± π
π π by (rule π)
lemmas L_10_5_Ο
_arrow_components' = L_10_5_Ο
_arrow_components[
where π=π and π=π, unfolded cat_cs_simps
]
lemmas [cat_Kan_cs_simps] = L_10_5_Ο
_arrow_components'(2,3)
end
subsubsectionβΉArrow valueβΊ
mk_VLambda L_10_5_Ο
_arrow_components(1)
|vsv L_10_5_Ο
_arrow_ArrVal_vsv[cat_Kan_cs_intros]|
context
fixes Ξ± π
β π π π
assumes π: "π : π
β¦β¦β©CβΞ±β β"
and π: "π : π
β¦β¦β©CβΞ±β π"
begin
mk_VLambda L_10_5_Ο
_arrow_components'(1)[OF π π]
|vdomain L_10_5_Ο
_arrow_ArrVal_vdomain[cat_Kan_cs_simps]|
|app L_10_5_Ο
_arrow_ArrVal_app[unfolded in_Hom_iff]|
end
lemma L_10_5_Ο
_arrow_ArrVal_app':
assumes "π : π
β¦β¦β©CβΞ±β β"
and "π : π
β¦β¦β©CβΞ±β π"
and "f : c β¦βββ πβ¦ObjMapβ¦β¦bβ¦"
shows "L_10_5_Ο
_arrow π π c Ο a bβ¦ArrValβ¦β¦fβ¦ = Οβ¦NTMapβ¦β¦0, b, fβ¦β©β"
proof-
interpret π: is_functor Ξ± π
β π by (rule assms(1))
interpret π: is_functor Ξ± π
π π by (rule assms(2))
from assms(3) have c: "c ββ©β ββ¦Objβ¦" by auto
show ?thesis by (rule L_10_5_Ο
_arrow_ArrVal_app[OF assms(1,2,3)])
qed
subsubsectionβΉβΉL_10_5_Ο
_arrowβΊ is an arrowβΊ
lemma L_10_5_Ο
_arrow_ArrVal_is_arr:
assumes "π : π
β¦β¦β©CβΞ±β β"
and "π : π
β¦β¦β©CβΞ±β π"
and "Ο' = ntcf_arrow Ο"
and "Ο : a <β©Cβ©Fβ©.β©cβ©oβ©nβ©e π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π : c ββ©Cβ©F π β¦β¦β©CβΞ±β π"
and "f : c β¦βββ πβ¦ObjMapβ¦β¦bβ¦"
and "b ββ©β π
β¦Objβ¦"
shows "L_10_5_Ο
_arrow π π c Ο' a bβ¦ArrValβ¦β¦fβ¦ : a β¦βπβ πβ¦ObjMapβ¦β¦bβ¦"
proof-
interpret π: is_functor Ξ± π
β π by (rule assms(1))
interpret π: is_functor Ξ± π
π π by (rule assms(2))
interpret Ο: is_cat_cone Ξ± a βΉc ββ©Cβ©F πβΊ π βΉπ ββ©Cβ©F c β©Oβ¨
β©Cβ©F πβΊ Ο by (rule assms(4))
from assms(5,6) show ?thesis
unfolding assms(3)
by
(
cs_concl
cs_simp:
cat_cs_simps
L_10_5_Ο
_arrow_ArrVal_app
cat_comma_cs_simps
cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_comma_cs_intros
)
qed
lemma L_10_5_Ο
_arrow_ArrVal_is_arr'[cat_Kan_cs_intros]:
assumes "π : π
β¦β¦β©CβΞ±β β"
and "π : π
β¦β¦β©CβΞ±β π"
and "Ο' = ntcf_arrow Ο"
and "a' = a"
and "b' = πβ¦ObjMapβ¦β¦bβ¦"
and "π' = π"
and "Ο : a <β©Cβ©Fβ©.β©cβ©oβ©nβ©e π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π : c ββ©Cβ©F π β¦β¦β©CβΞ±β π"
and "f : c β¦βββ πβ¦ObjMapβ¦β¦bβ¦"
and "b ββ©β π
β¦Objβ¦"
shows "L_10_5_Ο
_arrow π π c Ο' a bβ¦ArrValβ¦β¦fβ¦ : a' β¦βπβ b'"
using assms(1-3, 7-9)
unfolding assms(3-6)
by (rule L_10_5_Ο
_arrow_ArrVal_is_arr)
subsubsectionβΉFurther elementary propertiesβΊ
lemma L_10_5_Ο
_arrow_is_arr:
assumes "π : π
β¦β¦β©CβΞ±β β"
and "π : π
β¦β¦β©CβΞ±β π"
and "c ββ©β ββ¦Objβ¦"
and "Ο' = ntcf_arrow Ο"
and "Ο : a <β©Cβ©Fβ©.β©cβ©oβ©nβ©e π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π : c ββ©Cβ©F π β¦β¦β©CβΞ±β π"
and "b ββ©β π
β¦Objβ¦"
shows "L_10_5_Ο
_arrow π π c Ο' a b :
Hom β c (πβ¦ObjMapβ¦β¦bβ¦) β¦βcat_Set Ξ±β Hom π a (πβ¦ObjMapβ¦β¦bβ¦)"
proof-
note L_10_5_Ο
_arrow_components = L_10_5_Ο
_arrow_components'[OF assms(1,2)]
interpret π: is_functor Ξ± π
β π by (rule assms(1))
interpret π: is_functor Ξ± π
π π by (rule assms(2))
interpret Ο: is_cat_cone Ξ± a βΉc ββ©Cβ©F πβΊ π βΉπ ββ©Cβ©F c β©Oβ¨
β©Cβ©F πβΊ Ο by (rule assms(5))
show ?thesis
proof(intro cat_Set_is_arrI)
show "arr_Set Ξ± (L_10_5_Ο
_arrow π π c Ο' a b)"
proof(intro arr_SetI)
show "vfsequence (L_10_5_Ο
_arrow π π c Ο' a b)"
unfolding L_10_5_Ο
_arrow_def by simp
show "vcard (L_10_5_Ο
_arrow π π c Ο' a b) = 3β©β"
unfolding L_10_5_Ο
_arrow_def by (simp add: nat_omega_simps)
show
"ββ©β (L_10_5_Ο
_arrow π π c Ο' a bβ¦ArrValβ¦) ββ©β
L_10_5_Ο
_arrow π π c Ο' a bβ¦ArrCodβ¦"
unfolding L_10_5_Ο
_arrow_components
proof(intro vrange_VLambda_vsubset, unfold in_Hom_iff)
fix f assume "f : c β¦βββ πβ¦ObjMapβ¦β¦bβ¦"
from L_10_5_Ο
_arrow_ArrVal_is_arr[OF assms(1,2,4,5) this assms(6)] this
show "Ο'β¦NTMapβ¦β¦0, b, fβ¦β©β : a β¦βπβ πβ¦ObjMapβ¦β¦bβ¦"
by
(
cs_prems
cs_simp: L_10_5_Ο
_arrow_ArrVal_app' cat_cs_simps
cs_intro: cat_cs_intros
)
qed
from assms(3,6) show "L_10_5_Ο
_arrow π π c Ο' a bβ¦ArrDomβ¦ ββ©β Vset Ξ±"
by (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)
from assms(1-3,6) Ο.cat_cone_obj show
"L_10_5_Ο
_arrow π π c Ο' a bβ¦ArrCodβ¦ ββ©β Vset Ξ±"
by (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)
qed (auto simp: L_10_5_Ο
_arrow_components)
qed (simp_all add: L_10_5_Ο
_arrow_components)
qed
lemma L_10_5_Ο
_arrow_is_arr'[cat_Kan_cs_intros]:
assumes "π : π
β¦β¦β©CβΞ±β β"
and "π : π
β¦β¦β©CβΞ±β π"
and "c ββ©β ββ¦Objβ¦"
and "Ο' = ntcf_arrow Ο"
and "Ο : a <β©Cβ©Fβ©.β©cβ©oβ©nβ©e π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π : c ββ©Cβ©F π β¦β¦β©CβΞ±β π"
and "b ββ©β π
β¦Objβ¦"
and "A = Hom β c (πβ¦ObjMapβ¦β¦bβ¦)"
and "B = Hom π a (πβ¦ObjMapβ¦β¦bβ¦)"
and "β' = cat_Set Ξ±"
shows "L_10_5_Ο
_arrow π π c Ο' a b : A β¦ββ'β B"
using assms(1-6) unfolding assms(7-9) by (rule L_10_5_Ο
_arrow_is_arr)
lemma L_10_5_Ο
_cf_hom[cat_Kan_cs_simps]:
assumes "π : π
β¦β¦β©CβΞ±β β"
and "π : π
β¦β¦β©CβΞ±β π"
and "c ββ©β ββ¦Objβ¦"
and "Ο' = ntcf_arrow Ο"
and "Ο : a <β©Cβ©Fβ©.β©cβ©oβ©nβ©e π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π : c ββ©Cβ©F π β¦β¦β©CβΞ±β π"
and "a ββ©β πβ¦Objβ¦"
and "f : a' β¦βπ
β b'"
shows
"L_10_5_Ο
_arrow π π c Ο' a b' ββ©Aβcat_Set Ξ±β
cf_hom β [ββ¦CIdβ¦β¦cβ¦, πβ¦ArrMapβ¦β¦fβ¦]β©β =
cf_hom π [πβ¦CIdβ¦β¦aβ¦, πβ¦ArrMapβ¦β¦fβ¦]β©β ββ©Aβcat_Set Ξ±β
L_10_5_Ο
_arrow π π c Ο' a a'"
(is "?lhs = ?rhs")
proof-
interpret π: is_functor Ξ± π
β π by (rule assms(1))
interpret π: is_functor Ξ± π
π π by (rule assms(2))
interpret Ο: is_cat_cone Ξ± a βΉc ββ©Cβ©F πβΊ π βΉπ ββ©Cβ©F c β©Oβ¨
β©Cβ©F πβΊ Ο by (rule assms(5))
have [cat_Kan_cs_simps]:
"Οβ¦NTMapβ¦β¦a'', b'', πβ¦ArrMapβ¦β¦h'β¦ ββ©Aβββ f'β¦β©β =
πβ¦ArrMapβ¦β¦h'β¦ ββ©Aβπβ Οβ¦NTMapβ¦β¦a', b', f'β¦β©β"
if F_def: "F = [[a', b', f']β©β, [a'', b'', f'']β©β, [g', h']β©β]β©β"
and A_def: "A = [a', b', f']β©β"
and B_def: "B = [a'', b'', f'']β©β"
and F: "F : A β¦βc ββ©Cβ©F πβ B"
for F A B a' b' f' a'' b'' f'' g' h'
proof-
from F[unfolded F_def A_def B_def] assms(3) have a'_def: "a' = 0"
and a''_def: "a'' = 0"
and g'_def: "g' = 0"
and h': "h' : b' β¦βπ
β b''"
and f': "f' : c β¦βββ πβ¦ObjMapβ¦β¦b'β¦"
and f'': "f'' : c β¦βββ πβ¦ObjMapβ¦β¦b''β¦"
and f''_def: "πβ¦ArrMapβ¦β¦h'β¦ ββ©Aβββ f' = f''"
by auto
from
Ο.ntcf_Comp_commute[OF F]
that(2) F g' h' f' f''
π.is_functor_axioms
π.is_functor_axioms
show
"Οβ¦NTMapβ¦β¦a'', b'', πβ¦ArrMapβ¦β¦h'β¦ ββ©Aβββ f'β¦β©β =
πβ¦ArrMapβ¦β¦h'β¦ ββ©Aβπβ Οβ¦NTMapβ¦β¦a', b', f'β¦β©β"
unfolding F_def A_def B_def a'_def a''_def g'_def
by
(
cs_prems 1
cs_simp: cat_cs_simps cat_comma_cs_simps f''_def[symmetric]
cs_intro: cat_cs_intros cat_comma_cs_intros
)
qed
from assms(3) assms(6,7) π.HomCod.category_axioms have lhs_is_arr:
"?lhs : Hom β c (πβ¦ObjMapβ¦β¦a'β¦) β¦βcat_Set Ξ±β Hom π a (πβ¦ObjMapβ¦β¦b'β¦)"
unfolding assms(4)
by
(
cs_concl cs_simp: cs_intro:
cat_lim_cs_intros
cat_cs_intros
cat_Kan_cs_intros
cat_prod_cs_intros
cat_op_intros
)
then have dom_lhs: "πβ©β ((?lhs)β¦ArrValβ¦) = Hom β c (πβ¦ObjMapβ¦β¦a'β¦)"
by (cs_concl cs_simp: cat_cs_simps)
from assms(3) assms(6,7) π.HomCod.category_axioms π.HomCod.category_axioms
have rhs_is_arr:
"?rhs : Hom β c (πβ¦ObjMapβ¦β¦a'β¦) β¦βcat_Set Ξ±β Hom π a (πβ¦ObjMapβ¦β¦b'β¦)"
unfolding assms(4)
by
(
cs_concl cs_intro:
cat_lim_cs_intros
cat_cs_intros
cat_Kan_cs_intros
cat_prod_cs_intros
cat_op_intros
)
then have dom_rhs: "πβ©β ((?rhs)β¦ArrValβ¦) = Hom β c (πβ¦ObjMapβ¦β¦a'β¦)"
by (cs_concl cs_simp: cat_cs_simps)
show ?thesis
proof(rule arr_Set_eqI)
from lhs_is_arr show arr_Set_lhs: "arr_Set Ξ± ?lhs"
by (auto dest: cat_Set_is_arrD(1))
from rhs_is_arr show arr_Set_rhs: "arr_Set Ξ± ?rhs"
by (auto dest: cat_Set_is_arrD(1))
show "?lhsβ¦ArrValβ¦ = ?rhsβ¦ArrValβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
fix g assume prems: "g : c β¦βββ πβ¦ObjMapβ¦β¦a'β¦"
from prems assms(7) have πf:
"πβ¦ArrMapβ¦β¦fβ¦ ββ©Aβββ g : c β¦βββ πβ¦ObjMapβ¦β¦b'β¦"
by (cs_concl cs_intro: cat_cs_intros)
with assms(6,7) prems π.HomCod.category_axioms π.HomCod.category_axioms
show "?lhsβ¦ArrValβ¦β¦gβ¦ = ?rhsβ¦ArrValβ¦β¦gβ¦"
by
(
cs_concl
cs_intro:
cat_lim_cs_intros
cat_cs_intros
cat_Kan_cs_intros
cat_comma_cs_intros
cat_prod_cs_intros
cat_op_intros
cat_1_is_arrI
cs_simp:
L_10_5_Ο
_arrow_ArrVal_app'
cat_cs_simps
cat_Kan_cs_simps
cat_op_simps
cat_FUNCT_cs_simps
cat_comma_cs_simps
assms(4)
)+
qed (use arr_Set_lhs arr_Set_rhs in auto)
qed
(
use lhs_is_arr rhs_is_arr in
βΉcs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_introsβΊ
)+
qed
subsectionβΉLemma X.5: βΉL_10_5_ΟβΊβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition L_10_5_Ο where "L_10_5_Ο π π c Ο
a =
[
(Ξ»bfββ©βc ββ©Cβ©F πβ¦Objβ¦. Ο
β¦NTMapβ¦β¦bfβ¦1β©ββ¦β¦β¦ArrValβ¦β¦bfβ¦2β©ββ¦β¦),
cf_const (c ββ©Cβ©F π) (πβ¦HomCodβ¦) a,
π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π,
c ββ©Cβ©F π,
(πβ¦HomCodβ¦)
]β©β"
textβΉComponents.βΊ
lemma L_10_5_Ο_components:
shows "L_10_5_Ο π π c Ο
aβ¦NTMapβ¦ =
(Ξ»bfββ©βc ββ©Cβ©F πβ¦Objβ¦. Ο
β¦NTMapβ¦β¦bfβ¦1β©ββ¦β¦β¦ArrValβ¦β¦bfβ¦2β©ββ¦β¦)"
and "L_10_5_Ο π π c Ο
aβ¦NTDomβ¦ = cf_const (c ββ©Cβ©F π) (πβ¦HomCodβ¦) a"
and "L_10_5_Ο π π c Ο
aβ¦NTCodβ¦ = π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π"
and "L_10_5_Ο π π c Ο
aβ¦NTDGDomβ¦ = c ββ©Cβ©F π"
and "L_10_5_Ο π π c Ο
aβ¦NTDGCodβ¦ = (πβ¦HomCodβ¦)"
unfolding L_10_5_Ο_def nt_field_simps by (simp_all add: nat_omega_simps)
context
fixes Ξ± π
β π π π
assumes π: "π : π
β¦β¦β©CβΞ±β β"
and π: "π : π
β¦β¦β©CβΞ±β π"
begin
interpretation π: is_functor Ξ± π
β π by (rule π)
interpretation π: is_functor Ξ± π
π π by (rule π)
lemmas L_10_5_Ο_components' = L_10_5_Ο_components[
where π=π and π=π, unfolded cat_cs_simps
]
lemmas [cat_Kan_cs_simps] = L_10_5_Ο_components'(2-5)
end
subsubsectionβΉNatural transformation mapβΊ
mk_VLambda L_10_5_Ο_components(1)
|vsv L_10_5_Ο_NTMap_vsv[cat_Kan_cs_intros]|
|vdomain L_10_5_Ο_NTMap_vdomain[cat_Kan_cs_simps]|
lemma L_10_5_Ο_NTMap_app[cat_Kan_cs_simps]:
assumes "bf = [0, b, f]β©β" and "bf ββ©β c ββ©Cβ©F πβ¦Objβ¦"
shows "L_10_5_Ο π π c Ο
aβ¦NTMapβ¦β¦bfβ¦ = Ο
β¦NTMapβ¦β¦bβ¦β¦ArrValβ¦β¦fβ¦"
using assms unfolding L_10_5_Ο_components by (simp add: nat_omega_simps)
subsubsectionβΉβΉL_10_5_ΟβΊ is a coneβΊ
lemma L_10_5_Ο_is_cat_cone[cat_cs_intros]:
assumes "π : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
and "π : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β π"
and "c ββ©β ββ¦Objβ¦"
and Ο
'_def: "Ο
' = ntcf_arrow Ο
"
and Ο
: "Ο
:
Homβ©Oβ©.β©CβΞ±ββ(c,-) ββ©Cβ©F π β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F π : π
β¦β¦β©CβΞ±β cat_Set Ξ±"
and a: "a ββ©β πβ¦Objβ¦"
shows "L_10_5_Ο π π c Ο
' a : a <β©Cβ©Fβ©.β©cβ©oβ©nβ©e π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π : c ββ©Cβ©F π β¦β¦β©CβΞ±β π"
proof-
let ?H_β = βΉΞ»c. Homβ©Oβ©.β©CβΞ±ββ(c,-)βΊ
let ?H_π = βΉΞ»a. Homβ©Oβ©.β©CβΞ±βπ(a,-)βΊ
interpret π: is_tm_functor Ξ± π
β π by (rule assms(1))
interpret π: is_tm_functor Ξ± π
π π by (rule assms(2))
from assms(3) interpret cπ: tiny_category Ξ± βΉc ββ©Cβ©F πβΊ
by (cs_concl cs_intro: cat_comma_cs_intros)
from assms(3) interpret Ξ c: is_tm_functor Ξ± βΉc ββ©Cβ©F πβΊ π
βΉc β©Oβ¨
β©Cβ©F πβΊ
by
(
cs_concl
cs_simp: cat_comma_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_comma_cs_intros
)
interpret Ο
: is_ntcf Ξ± π
βΉcat_Set Ξ±βΊ βΉ?H_β c ββ©Cβ©F πβΊ βΉ?H_π a ββ©Cβ©F πβΊ Ο
by (rule Ο
)
show ?thesis
proof(intro is_cat_coneI is_tm_ntcfI' is_ntcfI')
show "vfsequence (L_10_5_Ο π π c Ο
' a)" unfolding L_10_5_Ο_def by simp
show "vcard (L_10_5_Ο π π c Ο
' a) = 5β©β"
unfolding L_10_5_Ο_def by (simp add: nat_omega_simps)
from a interpret cf_const:
is_tm_functor Ξ± βΉc ββ©Cβ©F πβΊ π βΉcf_const (c ββ©Cβ©F π) π aβΊ
by (cs_concl cs_intro: cat_small_cs_intros cat_cs_intros)
show "L_10_5_Ο π π c Ο
' aβ¦NTMapβ¦β¦bfβ¦ :
cf_const (c ββ©Cβ©F π) π aβ¦ObjMapβ¦β¦bfβ¦ β¦βπβ (π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π)β¦ObjMapβ¦β¦bfβ¦"
if "bf ββ©β c ββ©Cβ©F πβ¦Objβ¦" for bf
proof-
from that assms(3) obtain b f
where bf_def: "bf = [0, b, f]β©β"
and b: "b ββ©β π
β¦Objβ¦"
and f: "f : c β¦βββ πβ¦ObjMapβ¦β¦bβ¦"
by auto
from Ο
.ntcf_NTMap_is_arr[OF b] a b assms(3) f have "Ο
β¦NTMapβ¦β¦bβ¦ :
Hom β c (πβ¦ObjMapβ¦β¦bβ¦) β¦βcat_Set Ξ±β Hom π a (πβ¦ObjMapβ¦β¦bβ¦)"
by
(
cs_prems
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros
)
with that b f show "L_10_5_Ο π π c Ο
' aβ¦NTMapβ¦β¦bfβ¦ :
cf_const (c ββ©Cβ©F π) π aβ¦ObjMapβ¦β¦bfβ¦ β¦βπβ (π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π)β¦ObjMapβ¦β¦bfβ¦"
unfolding bf_def Ο
'_def
by
(
cs_concl
cs_simp:
cat_cs_simps
cat_Kan_cs_simps
cat_comma_cs_simps
cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_comma_cs_intros
)
qed
show
"L_10_5_Ο π π c Ο
' aβ¦NTMapβ¦β¦Bβ¦ ββ©Aβπβ cf_const (c ββ©Cβ©F π) π aβ¦ArrMapβ¦β¦Fβ¦ =
(π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π)β¦ArrMapβ¦β¦Fβ¦ ββ©Aβπβ L_10_5_Ο π π c Ο
' aβ¦NTMapβ¦β¦Aβ¦"
if "F : A β¦βc ββ©Cβ©F πβ B" for A B F
proof-
from π.is_functor_axioms that assms(3) obtain a' f a'' f' g
where F_def: "F = [[0, a', f]β©β, [0, a'', f']β©β, [0, g]β©β]β©β"
and A_def: "A = [0, a', f]β©β"
and B_def: "B = [0, a'', f']β©β"
and g: "g : a' β¦βπ
β a''"
and f: "f : c β¦βββ πβ¦ObjMapβ¦β¦a'β¦"
and f': "f' : c β¦βββ πβ¦ObjMapβ¦β¦a''β¦"
and f'_def: "πβ¦ArrMapβ¦β¦gβ¦ ββ©Aβββ f = f'"
by auto
from Ο
.ntcf_Comp_commute[OF g] have
"(Ο
β¦NTMapβ¦β¦a''β¦ ββ©Aβcat_Set Ξ±β (?H_β c ββ©Cβ©F π)β¦ArrMapβ¦β¦gβ¦)β¦ArrValβ¦β¦fβ¦ =
((?H_π a ββ©Cβ©F π)β¦ArrMapβ¦β¦gβ¦ ββ©Aβcat_Set Ξ±β Ο
β¦NTMapβ¦β¦a'β¦)β¦ArrValβ¦β¦fβ¦"
by simp
from this a g f f' π.HomCod.category_axioms π.HomCod.category_axioms
have [cat_cs_simps]:
"Ο
β¦NTMapβ¦β¦a''β¦β¦ArrValβ¦β¦πβ¦ArrMapβ¦β¦gβ¦ ββ©Aβββ fβ¦ =
πβ¦ArrMapβ¦β¦gβ¦ ββ©Aβπβ Ο
β¦NTMapβ¦β¦a'β¦β¦ArrValβ¦β¦fβ¦"
by
(
cs_prems
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_prod_cs_intros cat_op_intros
)
from that a g f f' π.HomCod.category_axioms π.HomCod.category_axioms
show ?thesis
unfolding F_def A_def B_def Ο
'_def
by
(
cs_concl
cs_simp:
f'_def[symmetric]
cat_cs_simps
cat_Kan_cs_simps
cat_comma_cs_simps
cat_FUNCT_cs_simps
cat_op_simps
cs_intro: cat_cs_intros cat_op_intros
)
qed
qed
(
use assms in
βΉ
cs_concl
cs_simp: cat_cs_simps cat_Kan_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_Kan_cs_intros a
βΊ
)+
qed
lemma L_10_5_Ο_is_cat_cone'[cat_Kan_cs_intros]:
assumes "π : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
and "π : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β π"
and "c ββ©β ββ¦Objβ¦"
and "Ο
' = ntcf_arrow Ο
"
and "π' = π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π"
and "cπ = c ββ©Cβ©F π"
and "π' = π"
and "Ξ±' = Ξ±"
and "Ο
:
Homβ©Oβ©.β©CβΞ±ββ(c,-) ββ©Cβ©F π β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F π :
π
β¦β¦β©CβΞ±β cat_Set Ξ±"
and "a ββ©β πβ¦Objβ¦"
shows "L_10_5_Ο π π c Ο
' a : a <β©Cβ©Fβ©.β©cβ©oβ©nβ©e π' : cπ β¦β¦β©CβΞ±'β π'"
using assms(1-4,9,10) unfolding assms(5-8) by (rule L_10_5_Ο_is_cat_cone)
subsectionβΉLemma X.5: βΉL_10_5_Ο
βΊβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition L_10_5_Ο
:: "V β V β V β V β V β V β V"
where "L_10_5_Ο
Ξ± π π c Ο a =
[
(Ξ»bββ©βπβ¦HomDomβ¦β¦Objβ¦. L_10_5_Ο
_arrow π π c Ο a b),
Homβ©Oβ©.β©CβΞ±βπβ¦HomCodβ¦(c,-) ββ©Cβ©F π,
Homβ©Oβ©.β©CβΞ±βπβ¦HomCodβ¦(a,-) ββ©Cβ©F π,
πβ¦HomDomβ¦,
cat_Set Ξ±
]β©β"
textβΉComponents.βΊ
lemma L_10_5_Ο
_components:
shows "L_10_5_Ο
Ξ± π π c Ο aβ¦NTMapβ¦ =
(Ξ»bββ©βπβ¦HomDomβ¦β¦Objβ¦. L_10_5_Ο
_arrow π π c Ο a b)"
and "L_10_5_Ο
Ξ± π π c Ο aβ¦NTDomβ¦ = Homβ©Oβ©.β©CβΞ±βπβ¦HomCodβ¦(c,-) ββ©Cβ©F π"
and "L_10_5_Ο
Ξ± π π c Ο aβ¦NTCodβ¦ = Homβ©Oβ©.β©CβΞ±βπβ¦HomCodβ¦(a,-) ββ©Cβ©F π"
and "L_10_5_Ο
Ξ± π π c Ο aβ¦NTDGDomβ¦ = πβ¦HomDomβ¦"
and "L_10_5_Ο
Ξ± π π c Ο aβ¦NTDGCodβ¦ = cat_Set Ξ±"
unfolding L_10_5_Ο
_def nt_field_simps by (simp_all add: nat_omega_simps)
context
fixes Ξ± π
β π π π
assumes π: "π : π
β¦β¦β©CβΞ±β β"
and π: "π : π
β¦β¦β©CβΞ±β π"
begin
interpretation π: is_functor Ξ± π
β π by (rule π)
interpretation π: is_functor Ξ± π
π π by (rule π)
lemmas L_10_5_Ο
_components' = L_10_5_Ο
_components[
where π=π and π=π, unfolded cat_cs_simps
]
lemmas [cat_Kan_cs_simps] = L_10_5_Ο
_components'(2-5)
end
subsubsectionβΉNatural transformation mapβΊ
mk_VLambda L_10_5_Ο
_components(1)
|vsv L_10_5_Ο
_NTMap_vsv[cat_Kan_cs_intros]|
context
fixes Ξ± π
β π π π
assumes π: "π : π
β¦β¦β©CβΞ±β β"
and π: "π : π
β¦β¦β©CβΞ±β π"
begin
interpretation π: is_functor Ξ± π
β π by (rule π)
interpretation π: is_functor Ξ± π
π π by (rule π)
mk_VLambda L_10_5_Ο
_components'(1)[OF π π]
|vdomain L_10_5_Ο
_NTMap_vdomain[cat_Kan_cs_simps]|
|app L_10_5_Ο
_NTMap_app[cat_Kan_cs_simps]|
end
subsubsectionβΉβΉL_10_5_Ο
βΊ is a natural transformationβΊ
lemma L_10_5_Ο
_is_ntcf:
assumes "π : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
and "π : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β π"
and "c ββ©β ββ¦Objβ¦"
and Ο'_def: "Ο' = ntcf_arrow Ο"
and Ο: "Ο : a <β©Cβ©Fβ©.β©cβ©oβ©nβ©e π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π : c ββ©Cβ©F π β¦β¦β©CβΞ±β π"
and a: "a ββ©β πβ¦Objβ¦"
shows "L_10_5_Ο
Ξ± π π c Ο' a :
Homβ©Oβ©.β©CβΞ±ββ(c,-) ββ©Cβ©F π β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F π : π
β¦β¦β©CβΞ±β cat_Set Ξ±"
(is βΉ?L_10_5_Ο
: ?H_β c ββ©Cβ©F π β¦β©Cβ©F ?H_π a ββ©Cβ©F π : π
β¦β¦β©CβΞ±β cat_Set Ξ±βΊ)
proof-
interpret π: is_tm_functor Ξ± π
β π by (rule assms(1))
interpret π: is_tm_functor Ξ± π
π π by (rule assms(2))
interpret Ο: is_cat_cone Ξ± a βΉc ββ©Cβ©F πβΊ π βΉπ ββ©Cβ©F c β©Oβ¨
β©Cβ©F πβΊ Ο
by (rule assms(5))
from assms(3) interpret cπ: tiny_category Ξ± βΉc ββ©Cβ©F πβΊ
by (cs_concl cs_intro: cat_comma_cs_intros)
from assms(3) interpret Ξ c: is_tm_functor Ξ± βΉc ββ©Cβ©F πβΊ π
βΉc β©Oβ¨
β©Cβ©F πβΊ
by
(
cs_concl
cs_simp: cat_comma_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_comma_cs_intros
)
show "?L_10_5_Ο
: ?H_β c ββ©Cβ©F π β¦β©Cβ©F ?H_π a ββ©Cβ©F π : π
β¦β¦β©CβΞ±β cat_Set Ξ±"
proof(intro is_ntcfI')
show "vfsequence ?L_10_5_Ο
" unfolding L_10_5_Ο
_def by auto
show "vcard ?L_10_5_Ο
= 5β©β"
unfolding L_10_5_Ο
_def by (simp add: nat_omega_simps)
show "?L_10_5_Ο
β¦NTMapβ¦β¦bβ¦ :
(?H_β c ββ©Cβ©F π)β¦ObjMapβ¦β¦bβ¦ β¦βcat_Set Ξ±β (?H_π a ββ©Cβ©F π)β¦ObjMapβ¦β¦bβ¦"
if "b ββ©β π
β¦Objβ¦" for b
proof-
from a that assms(3) show ?thesis
unfolding Ο'_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_Kan_cs_simps
cs_intro:
cat_Kan_cs_intros
cat_lim_cs_intros
cat_cs_intros
cat_op_intros
)
qed
show
"?L_10_5_Ο
β¦NTMapβ¦β¦b'β¦ ββ©Aβcat_Set Ξ±β (?H_β c ββ©Cβ©F π)β¦ArrMapβ¦β¦fβ¦ =
(?H_π a ββ©Cβ©F π)β¦ArrMapβ¦β¦fβ¦ ββ©Aβcat_Set Ξ±β ?L_10_5_Ο
β¦NTMapβ¦β¦a'β¦"
if "f : a' β¦βπ
β b'" for a' b' f
proof-
from that a assms(3) show ?thesis
by
(
cs_concl
cs_simp: cat_cs_simps cat_Kan_cs_simps cat_op_simps Ο'_def
cs_intro: cat_lim_cs_intros cat_cs_intros
)
qed
qed
(
use assms(3,6) in
βΉ
cs_concl
cs_simp: cat_cs_simps cat_Kan_cs_simps
cs_intro: cat_cs_intros cat_Kan_cs_intros
βΊ
)+
qed
lemma L_10_5_Ο
_is_ntcf'[cat_Kan_cs_intros]:
assumes "π : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
and "π : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β π"
and "c ββ©β ββ¦Objβ¦"
and "Ο' = ntcf_arrow Ο"
and "π' = Homβ©Oβ©.β©CβΞ±ββ(c,-) ββ©Cβ©F π"
and "π' = Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F π"
and "π
' = π
"
and "β' = cat_Set Ξ±"
and "Ξ±' = Ξ±"
and "Ο : a <β©Cβ©Fβ©.β©cβ©oβ©nβ©e π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π : c ββ©Cβ©F π β¦β¦β©CβΞ±β π"
and "a ββ©β πβ¦Objβ¦"
shows "L_10_5_Ο
Ξ± π π c Ο' a : π' β¦β©Cβ©F π' : π
' β¦β¦β©CβΞ±'β β'"
using assms(1-4,10,11) unfolding assms(5-9) by (rule L_10_5_Ο
_is_ntcf)
subsectionβΉLemma X.5: βΉL_10_5_Ο_arrowβΊβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition L_10_5_Ο_arrow
where "L_10_5_Ο_arrow Ξ± Ξ² π π c a =
[
(Ξ»Ο
ββ©βL_10_5_N Ξ± Ξ² π π cβ¦ObjMapβ¦β¦aβ¦. ntcf_arrow (L_10_5_Ο π π c Ο
a)),
L_10_5_N Ξ± Ξ² π π cβ¦ObjMapβ¦β¦aβ¦,
cf_Cone Ξ± Ξ² (π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π)β¦ObjMapβ¦β¦aβ¦
]β©β"
textβΉComponents.βΊ
lemma L_10_5_Ο_arrow_components:
shows "L_10_5_Ο_arrow Ξ± Ξ² π π c aβ¦ArrValβ¦ =
(Ξ»Ο
ββ©βL_10_5_N Ξ± Ξ² π π cβ¦ObjMapβ¦β¦aβ¦. ntcf_arrow (L_10_5_Ο π π c Ο
a))"
and "L_10_5_Ο_arrow Ξ± Ξ² π π c aβ¦ArrDomβ¦ = L_10_5_N Ξ± Ξ² π π cβ¦ObjMapβ¦β¦aβ¦"
and "L_10_5_Ο_arrow Ξ± Ξ² π π c aβ¦ArrCodβ¦ =
cf_Cone Ξ± Ξ² (π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π)β¦ObjMapβ¦β¦aβ¦"
unfolding L_10_5_Ο_arrow_def arr_field_simps
by (simp_all add: nat_omega_simps)
lemmas [cat_Kan_cs_simps] = L_10_5_Ο_arrow_components(2,3)
subsubsectionβΉArrow valueβΊ
mk_VLambda L_10_5_Ο_arrow_components(1)
|vsv L_10_5_Ο_arrow_vsv[cat_Kan_cs_intros]|
|vdomain L_10_5_Ο_arrow_vdomain|
|app L_10_5_Ο_arrow_app|
lemma L_10_5_Ο_arrow_vdomain'[cat_Kan_cs_simps]:
assumes "π΅ Ξ²"
and "Ξ± ββ©β Ξ²"
and "π : π
β¦β¦β©CβΞ±β β"
and "π : π
β¦β¦β©CβΞ±β π"
and "c ββ©β ββ¦Objβ¦"
and "a ββ©β πβ¦Objβ¦"
shows "πβ©β (L_10_5_Ο_arrow Ξ± Ξ² π π c aβ¦ArrValβ¦) = Hom
(cat_FUNCT Ξ± π
(cat_Set Ξ±))
(cf_map (Homβ©Oβ©.β©CβΞ±ββ(c,-) ββ©Cβ©F π))
(cf_map (Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F π))"
using assms
by
(
cs_concl
cs_simp: cat_cs_simps cat_Kan_cs_simps L_10_5_Ο_arrow_vdomain
cs_intro: cat_cs_intros
)
lemma L_10_5_Ο_arrow_app'[cat_Kan_cs_simps]:
assumes "π΅ Ξ²"
and "Ξ± ββ©β Ξ²"
and "π : π
β¦β¦β©CβΞ±β β"
and "π : π
β¦β¦β©CβΞ±β π"
and "c ββ©β ββ¦Objβ¦"
and Ο
'_def: "Ο
' = ntcf_arrow Ο
"
and Ο
: "Ο
:
Homβ©Oβ©.β©CβΞ±ββ(c,-) ββ©Cβ©F π β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F π : π
β¦β¦β©CβΞ±β cat_Set Ξ±"
and a: "a ββ©β πβ¦Objβ¦"
shows
"L_10_5_Ο_arrow Ξ± Ξ² π π c aβ¦ArrValβ¦β¦Ο
'β¦ =
ntcf_arrow (L_10_5_Ο π π c Ο
' a)"
using assms
by
(
cs_concl
cs_simp: cat_cs_simps cat_Kan_cs_simps L_10_5_Ο_arrow_app
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
lemma Ο
Οa_def:
assumes "π : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
and "π : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β π"
and "c ββ©β ββ¦Objβ¦"
and Ο
Οa'_def: "Ο
Οa' = ntcf_arrow Ο
Οa"
and Ο
Οa: "Ο
Οa :
Homβ©Oβ©.β©CβΞ±ββ(c,-) ββ©Cβ©F π β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F π :
π
β¦β¦β©CβΞ±β cat_Set Ξ±"
and a: "a ββ©β πβ¦Objβ¦"
shows "Ο
Οa = L_10_5_Ο
Ξ± π π c (ntcf_arrow (L_10_5_Ο π π c Ο
Οa' a)) a"
(is βΉΟ
Οa = ?L_10_5_Ο
(ntcf_arrow ?L_10_5_Ο) aβΊ)
proof-
interpret π: is_tm_functor Ξ± π
β π by (rule assms(1))
interpret π: is_tm_functor Ξ± π
π π by (rule assms(2))
interpret Ο
Οa: is_ntcf
Ξ± π
βΉcat_Set Ξ±βΊ βΉHomβ©Oβ©.β©CβΞ±ββ(c,-) ββ©Cβ©F πβΊ βΉHomβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F πβΊ Ο
Οa
by (rule Ο
Οa)
show ?thesis
proof(rule ntcf_eqI)
show "Ο
Οa :
Homβ©Oβ©.β©CβΞ±ββ(c,-) ββ©Cβ©F π β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F π : π
β¦β¦β©CβΞ±β cat_Set Ξ±"
by (rule Ο
Οa)
from assms(1-3) a show
"?L_10_5_Ο
(ntcf_arrow ?L_10_5_Ο) a :
Homβ©Oβ©.β©CβΞ±ββ(c,-) ββ©Cβ©F π β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F π : π
β¦β¦β©CβΞ±β cat_Set Ξ±"
by
(
cs_concl
cs_simp: cat_Kan_cs_simps Ο
Οa'_def
cs_intro: cat_cs_intros cat_Kan_cs_intros
)
have dom_lhs: "πβ©β (Ο
Οaβ¦NTMapβ¦) = π
β¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps)
have dom_rhs: "πβ©β (?L_10_5_Ο
(ntcf_arrow (?L_10_5_Ο)) aβ¦NTMapβ¦) = π
β¦Objβ¦"
by (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)
show "Ο
Οaβ¦NTMapβ¦ = ?L_10_5_Ο
(ntcf_arrow ?L_10_5_Ο) aβ¦NTMapβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix b assume prems: "b ββ©β π
β¦Objβ¦"
from prems assms(3) a have lhs: "Ο
Οaβ¦NTMapβ¦β¦bβ¦ :
Hom β c (πβ¦ObjMapβ¦β¦bβ¦) β¦βcat_Set Ξ±β Hom π a (πβ¦ObjMapβ¦β¦bβ¦)"
by
(
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
)
then have dom_lhs: "πβ©β (Ο
Οaβ¦NTMapβ¦β¦bβ¦β¦ArrValβ¦) = Hom β c (πβ¦ObjMapβ¦β¦bβ¦)"
by (cs_concl cs_simp: cat_cs_simps)
from prems assms(3) a have rhs:
"L_10_5_Ο
_arrow π π c (ntcf_arrow ?L_10_5_Ο) a b :
Hom β c (πβ¦ObjMapβ¦β¦bβ¦) β¦βcat_Set Ξ±β Hom π a (πβ¦ObjMapβ¦β¦bβ¦)"
unfolding Ο
Οa'_def
by
(
cs_concl
cs_simp: cat_Kan_cs_simps
cs_intro: cat_small_cs_intros cat_Kan_cs_intros cat_cs_intros
)
then have dom_rhs:
"πβ©β (L_10_5_Ο
_arrow π π c (ntcf_arrow ?L_10_5_Ο) a bβ¦ArrValβ¦) =
Hom β c (πβ¦ObjMapβ¦β¦bβ¦)"
by (cs_concl cs_simp: cat_cs_simps)
have [cat_cs_simps]:
"Ο
Οaβ¦NTMapβ¦β¦bβ¦ = L_10_5_Ο
_arrow π π c (ntcf_arrow ?L_10_5_Ο) a b"
proof(rule arr_Set_eqI)
from lhs show arr_Set_lhs: "arr_Set Ξ± (Ο
Οaβ¦NTMapβ¦β¦bβ¦)"
by (auto dest: cat_Set_is_arrD(1))
from rhs show arr_Set_rhs:
"arr_Set Ξ± (L_10_5_Ο
_arrow π π c (ntcf_arrow (?L_10_5_Ο)) a b)"
by (auto dest: cat_Set_is_arrD(1))
show "Ο
Οaβ¦NTMapβ¦β¦bβ¦β¦ArrValβ¦ =
L_10_5_Ο
_arrow π π c (ntcf_arrow ?L_10_5_Ο) a bβ¦ArrValβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
fix f assume "f : c β¦βββ πβ¦ObjMapβ¦β¦bβ¦"
with assms prems show
"Ο
Οaβ¦NTMapβ¦β¦bβ¦β¦ArrValβ¦β¦fβ¦ =
L_10_5_Ο
_arrow π π c (ntcf_arrow ?L_10_5_Ο) a bβ¦ArrValβ¦β¦fβ¦"
unfolding Ο
Οa'_def
by
(
cs_concl
cs_simp:
cat_Kan_cs_simps cat_FUNCT_cs_simps L_10_5_Ο
_arrow_ArrVal_app
cs_intro: cat_cs_intros cat_comma_cs_intros
)
qed (use arr_Set_lhs arr_Set_rhs in auto)
qed (use lhs rhs in βΉcs_concl cs_simp: cat_cs_simpsβΊ)+
from prems show
"Ο
Οaβ¦NTMapβ¦β¦bβ¦ = L_10_5_Ο
Ξ± π π c (ntcf_arrow ?L_10_5_Ο) aβ¦NTMapβ¦β¦bβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps cat_Kan_cs_simps cs_intro: cat_cs_intros
)
qed (cs_concl cs_intro: cat_cs_intros cat_Kan_cs_intros V_cs_intros)+
qed simp_all
qed
subsectionβΉLemma X.5: βΉL_10_5_Ο'_arrowβΊβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition L_10_5_Ο'_arrow :: "V β V β V β V β V β V β V"
where "L_10_5_Ο'_arrow Ξ± Ξ² π π c a =
[
(
Ξ»Οββ©βcf_Cone Ξ± Ξ² (π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π)β¦ObjMapβ¦β¦aβ¦.
ntcf_arrow (L_10_5_Ο
Ξ± π π c Ο a)
),
cf_Cone Ξ± Ξ² (π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π)β¦ObjMapβ¦β¦aβ¦,
L_10_5_N Ξ± Ξ² π π cβ¦ObjMapβ¦β¦aβ¦
]β©β"
textβΉComponents.βΊ
lemma L_10_5_Ο'_arrow_components:
shows "L_10_5_Ο'_arrow Ξ± Ξ² π π c aβ¦ArrValβ¦ =
(
Ξ»Οββ©βcf_Cone Ξ± Ξ² (π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π)β¦ObjMapβ¦β¦aβ¦.
ntcf_arrow (L_10_5_Ο
Ξ± π π c Ο a)
)"
and [cat_Kan_cs_simps]: "L_10_5_Ο'_arrow Ξ± Ξ² π π c aβ¦ArrDomβ¦ =
cf_Cone Ξ± Ξ² (π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π)β¦ObjMapβ¦β¦aβ¦"
and [cat_Kan_cs_simps]: "L_10_5_Ο'_arrow Ξ± Ξ² π π c aβ¦ArrCodβ¦ =
L_10_5_N Ξ± Ξ² π π cβ¦ObjMapβ¦β¦aβ¦"
unfolding L_10_5_Ο'_arrow_def arr_field_simps by (simp_all add: nat_omega_simps)
subsubsectionβΉArrow valueβΊ
mk_VLambda L_10_5_Ο'_arrow_components(1)
|vsv L_10_5_Ο'_arrow_ArrVal_vsv[cat_Kan_cs_intros]|
|vdomain L_10_5_Ο'_arrow_ArrVal_vdomain|
|app L_10_5_Ο'_arrow_ArrVal_app|
lemma L_10_5_Ο'_arrow_ArrVal_vdomain'[cat_Kan_cs_simps]:
assumes "π΅ Ξ²"
and "Ξ± ββ©β Ξ²"
and Ο: "Ο : a <β©Cβ©Fβ©.β©cβ©oβ©nβ©e π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π : c ββ©Cβ©F π β¦β¦β©CβΞ±β π"
and a: "a ββ©β πβ¦Objβ¦"
shows "πβ©β (L_10_5_Ο'_arrow Ξ± Ξ² π π c aβ¦ArrValβ¦) = Hom
(cat_Funct Ξ± (c ββ©Cβ©F π) π)
(cf_map (cf_const (c ββ©Cβ©F π) π a))
(cf_map (π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π))"
proof-
interpret Ξ²: π΅ Ξ² by (rule assms(1))
interpret Ο: is_cat_cone Ξ± a βΉc ββ©Cβ©F πβΊ π βΉπ ββ©Cβ©F c β©Oβ¨
β©Cβ©F πβΊ Ο
by (rule assms(3))
from assms(2,4) show ?thesis
by
(
cs_concl
cs_simp: cat_Kan_cs_simps L_10_5_Ο'_arrow_ArrVal_vdomain
cs_intro: cat_cs_intros
)
qed
lemma L_10_5_Ο'_arrow_ArrVal_app'[cat_cs_simps]:
assumes "π΅ Ξ²"
and "Ξ± ββ©β Ξ²"
and Ο'_def: "Ο' = ntcf_arrow Ο"
and Ο: "Ο : a <β©Cβ©Fβ©.β©cβ©oβ©nβ©e π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π : c ββ©Cβ©F π β¦β¦β©CβΞ±β π"
and a: "a ββ©β πβ¦Objβ¦"
shows "L_10_5_Ο'_arrow Ξ± Ξ² π π c aβ¦ArrValβ¦β¦Ο'β¦ =
ntcf_arrow (L_10_5_Ο
Ξ± π π c Ο' a)"
proof-
interpret Ξ²: π΅ Ξ² by (rule assms(1))
interpret Ο: is_cat_cone Ξ± a βΉc ββ©Cβ©F πβΊ π βΉπ ββ©Cβ©F c β©Oβ¨
β©Cβ©F πβΊ Ο
by (rule assms(4))
from assms(2,5) have "Ο' ββ©β cf_Cone Ξ± Ξ² (π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π)β¦ObjMapβ¦β¦aβ¦"
unfolding Ο'_def
by
(
cs_concl
cs_simp: cat_Kan_cs_simps cat_Funct_components(1)
cs_intro: cat_small_cs_intros cat_FUNCT_cs_intros cat_cs_intros
)
then show
"L_10_5_Ο'_arrow Ξ± Ξ² π π c aβ¦ArrValβ¦β¦Ο'β¦ =
ntcf_arrow (L_10_5_Ο
Ξ± π π c Ο' a)"
unfolding L_10_5_Ο'_arrow_components by auto
qed
subsubsectionβΉβΉL_10_5_Ο'_arrowβΊ is an isomorphism in the category βΉSetβΊβΊ
lemma L_10_5_Ο'_arrow_is_arr_isomorphism:
assumes "π΅ Ξ²"
and "Ξ± ββ©β Ξ²"
and "π : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
and "π : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β π"
and "c ββ©β ββ¦Objβ¦"
and "a ββ©β πβ¦Objβ¦"
shows "L_10_5_Ο'_arrow Ξ± Ξ² π π c a :
cf_Cone Ξ± Ξ² (π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π)β¦ObjMapβ¦β¦aβ¦ β¦β©iβ©sβ©oβcat_Set Ξ²β
L_10_5_N Ξ± Ξ² π π cβ¦ObjMapβ¦β¦aβ¦"
(
is
βΉ
?L_10_5_Ο'_arrow :
cf_Cone Ξ± Ξ² (π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π)β¦ObjMapβ¦β¦aβ¦ β¦β©iβ©sβ©oβcat_Set Ξ²β
?L_10_5_Nβ¦ObjMapβ¦β¦aβ¦
βΊ
)
proof-
let ?FUNCT = βΉΞ»π. cat_FUNCT Ξ± π (cat_Set Ξ±)βΊ
let ?cπ_π = βΉcat_Funct Ξ± (c ββ©Cβ©F π) πβΊ
let ?H_β = βΉΞ»c. Homβ©Oβ©.β©CβΞ±ββ(c,-)βΊ
let ?H_π = βΉΞ»c. Homβ©Oβ©.β©CβΞ±βπ(a,-)βΊ
from assms(1,2) interpret Ξ²: π΅ Ξ² by simp
interpret π: is_tm_functor Ξ± π
β π by (rule assms(3))
interpret π: is_tm_functor Ξ± π
π π by (rule assms(4))
from π.vempty_is_zet assms interpret cπ: tiny_category Ξ± βΉc ββ©Cβ©F πβΊ
by (cs_concl cs_intro: cat_comma_cs_intros)
from assms(2,6) interpret cπ_π: category Ξ± ?cπ_π
by
(
cs_concl cs_intro:
cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
from π.vempty_is_zet assms interpret Ξ c:
is_tm_functor Ξ± βΉc ββ©Cβ©F πβΊ π
βΉc β©Oβ¨
β©Cβ©F πβΊ
by (cs_concl cs_intro: cat_comma_cs_intros)
from assms(2) interpret FUNCT_π: tiny_category Ξ² βΉ?FUNCT πβΊ
by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
from assms(2) interpret FUNCT_π
: tiny_category Ξ² βΉ?FUNCT π
βΊ
by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
from assms(2) interpret FUNCT_β: tiny_category Ξ² βΉ?FUNCT ββΊ
by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
have πΞ : "π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π : c ββ©Cβ©F π β¦β¦β©Cβ©.β©tβ©mβΞ±β π"
by (cs_concl cs_intro: cat_small_cs_intros cat_cs_intros)
from assms(5,6) have [cat_cs_simps]:
"cf_of_cf_map (c ββ©Cβ©F π) π (cf_map (cf_const (c ββ©Cβ©F π) π a)) =
cf_const (c ββ©Cβ©F π) π a"
"cf_of_cf_map (c ββ©Cβ©F π) π (cf_map (π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π)) = π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π"
"cf_of_cf_map π
(cat_Set Ξ±) (cf_map (Homβ©Oβ©.β©CβΞ±ββ(c,-) ββ©Cβ©F π)) =
Homβ©Oβ©.β©CβΞ±ββ(c,-) ββ©Cβ©F π"
"cf_of_cf_map π
(cat_Set Ξ±) (cf_map (Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F π)) =
Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F π"
by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)+
note cf_Cone_ObjMap_app = is_tm_functor.cf_Cone_ObjMap_app[OF πΞ assms(1,2,6)]
show ?thesis
proof
(
intro cat_Set_is_arr_isomorphismI cat_Set_is_arrI arr_SetI,
unfold L_10_5_Ο'_arrow_components(3) cf_Cone_ObjMap_app
)
show "vfsequence ?L_10_5_Ο'_arrow"
unfolding L_10_5_Ο'_arrow_def by auto
show Ο'_arrow_ArrVal_vsv: "vsv (?L_10_5_Ο'_arrowβ¦ArrValβ¦)"
unfolding L_10_5_Ο'_arrow_components by auto
show "vcard ?L_10_5_Ο'_arrow = 3β©β"
unfolding L_10_5_Ο'_arrow_def by (simp add: nat_omega_simps)
show [cat_cs_simps]:
"πβ©β (?L_10_5_Ο'_arrowβ¦ArrValβ¦) = ?L_10_5_Ο'_arrowβ¦ArrDomβ¦"
unfolding L_10_5_Ο'_arrow_components by simp
show vrange_Ο'_arrow_vsubset_N'':
"ββ©β (?L_10_5_Ο'_arrowβ¦ArrValβ¦) ββ©β ?L_10_5_Nβ¦ObjMapβ¦β¦aβ¦"
unfolding L_10_5_Ο'_arrow_components
proof(rule vrange_VLambda_vsubset)
fix Ο assume prems: "Ο ββ©β cf_Cone Ξ± Ξ² (π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π)β¦ObjMapβ¦β¦aβ¦"
from this assms cπ_π.category_axioms have Ο_is_arr:
"Ο : cf_map (cf_const (c ββ©Cβ©F π) π a) β¦β?cπ_πβ cf_map (π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π)"
by
(
cs_prems
cs_simp: cat_cs_simps cat_Kan_cs_simps cat_Funct_components(1)
cs_intro: cat_small_cs_intros
)
note Ο = cat_Funct_is_arrD(1,2)[OF Ο_is_arr, unfolded cat_cs_simps]
have "cf_of_cf_map (c ββ©Cβ©F π) π (cf_map (π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π)) = π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π"
by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
from prems assms Ο(1) show
"ntcf_arrow (L_10_5_Ο
Ξ± π π c Ο a) ββ©β ?L_10_5_Nβ¦ObjMapβ¦β¦aβ¦"
by (subst Ο(2))
(
cs_concl
cs_simp: cat_cs_simps cat_Kan_cs_simps
cs_intro:
is_cat_coneI cat_cs_intros cat_Kan_cs_intros cat_FUNCT_cs_intros
)
qed
show "ββ©β (?L_10_5_Ο'_arrowβ¦ArrValβ¦) = ?L_10_5_Nβ¦ObjMapβ¦β¦aβ¦"
proof
(
intro vsubset_antisym[OF vrange_Ο'_arrow_vsubset_N''],
intro vsubsetI
)
fix Ο
Οa assume "Ο
Οa ββ©β ?L_10_5_Nβ¦ObjMapβ¦β¦aβ¦"
from this assms have Ο
Οa:
"Ο
Οa : cf_map (?H_β c ββ©Cβ©F π) β¦β?FUNCT π
β cf_map (?H_π a ββ©Cβ©F π)"
by
(
cs_prems
cs_simp: cat_cs_simps cat_Kan_cs_simps cs_intro: cat_cs_intros
)
note Ο
Οa = cat_FUNCT_is_arrD[OF this, unfolded cat_cs_simps]
interpret Ο:
is_cat_cone Ξ± a βΉc ββ©Cβ©F πβΊ π βΉπ ββ©Cβ©F c β©Oβ¨
β©Cβ©F πβΊ βΉL_10_5_Ο π π c Ο
Οa aβΊ
by (rule L_10_5_Ο_is_cat_cone[OF assms(3,4,5) Ο
Οa(2,1) assms(6)])
show "Ο
Οa ββ©β ββ©β (?L_10_5_Ο'_arrowβ¦ArrValβ¦)"
proof(rule vsv.vsv_vimageI2')
show "vsv (?L_10_5_Ο'_arrowβ¦ArrValβ¦)" by (rule Ο'_arrow_ArrVal_vsv)
from Ο.is_cat_cone_axioms assms show
"ntcf_arrow (L_10_5_Ο π π c Ο
Οa a) ββ©β πβ©β (?L_10_5_Ο'_arrowβ¦ArrValβ¦)"
by
(
cs_concl
cs_simp: cat_Kan_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
from assms Ο
Οa(1,2) show
"Ο
Οa = ?L_10_5_Ο'_arrowβ¦ArrValβ¦β¦ntcf_arrow (L_10_5_Ο π π c Ο
Οa a)β¦"
by
(
subst Ο
Οa(2),
cs_concl_step Ο
Οa_def[OF assms(3,4,5) Ο
Οa(2,1) assms(6)]
)
(cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
qed
from assms show "?L_10_5_Ο'_arrowβ¦ArrDomβ¦ ββ©β Vset Ξ²"
by (intro Vset_trans[OF _ Vset_in_mono[OF assms(2)]])
(
cs_concl
cs_simp: cat_Kan_cs_simps cat_Funct_components(1) cf_Cone_ObjMap_app
cs_intro:
cat_small_cs_intros
cat_cs_intros
cat_FUNCT_cs_intros
cπ_π.cat_Hom_in_Vset
)
with assms(2) have "?L_10_5_Ο'_arrowβ¦ArrDomβ¦ ββ©β Vset Ξ²"
by (meson Vset_in_mono Vset_trans)
from assms show "?L_10_5_Nβ¦ObjMapβ¦β¦aβ¦ ββ©β Vset Ξ²"
by
(
cs_concl
cs_simp: cat_cs_simps cat_Kan_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_cs_intros FUNCT_π
.cat_Hom_in_Vset cat_FUNCT_cs_intros
)
show dom_Ο'_arrow: "πβ©β (?L_10_5_Ο'_arrowβ¦ArrValβ¦) =
Hom ?cπ_π (cf_map (cf_const (c ββ©Cβ©F π) π a)) (cf_map (π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π))"
unfolding L_10_5_Ο'_arrow_components cf_Cone_ObjMap_app by simp
show "?L_10_5_Ο'_arrowβ¦ArrDomβ¦ =
Hom ?cπ_π (cf_map (cf_const (c ββ©Cβ©F π) π a)) (cf_map (π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π))"
unfolding L_10_5_Ο'_arrow_components cf_Cone_ObjMap_app by simp
show "v11 (?L_10_5_Ο'_arrowβ¦ArrValβ¦)"
proof(rule vsv.vsv_valeq_v11I, unfold dom_Ο'_arrow in_Hom_iff)
fix Ο' Ο'' assume prems:
"Ο' : cf_map (cf_const (c ββ©Cβ©F π) π a) β¦β?cπ_πβ cf_map (π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π)"
"Ο'' : cf_map (cf_const (c ββ©Cβ©F π) π a) β¦β?cπ_πβ cf_map (π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π)"
"?L_10_5_Ο'_arrowβ¦ArrValβ¦β¦Ο'β¦ = ?L_10_5_Ο'_arrowβ¦ArrValβ¦β¦Ο''β¦"
note Ο' = cat_Funct_is_arrD[OF prems(1), unfolded cat_cs_simps]
and Ο'' = cat_Funct_is_arrD[OF prems(2), unfolded cat_cs_simps]
interpret Ο': is_cat_cone
Ξ± a βΉc ββ©Cβ©F πβΊ π βΉπ ββ©Cβ©F c β©Oβ¨
β©Cβ©F πβΊ βΉntcf_of_ntcf_arrow (c ββ©Cβ©F π) π Ο'βΊ
by (rule is_cat_coneI[OF Ο'(1) assms(6)])
interpret Ο'': is_cat_cone
Ξ± a βΉc ββ©Cβ©F πβΊ π βΉπ ββ©Cβ©F c β©Oβ¨
β©Cβ©F πβΊ βΉntcf_of_ntcf_arrow (c ββ©Cβ©F π) π Ο''βΊ
by (rule is_cat_coneI[OF Ο''(1) assms(6)])
have Ο'Ο': "ntcf_arrow (ntcf_of_ntcf_arrow (c ββ©Cβ©F π) π Ο') = Ο'"
by (subst (2) Ο'(2)) (cs_concl cs_simp: cat_FUNCT_cs_simps)
have Ο''Ο'': "ntcf_arrow (ntcf_of_ntcf_arrow (c ββ©Cβ©F π) π Ο'') = Ο''"
by (subst (2) Ο''(2)) (cs_concl cs_simp: cat_FUNCT_cs_simps)
from prems(3) Ο'(1) Ο''(1) assms have
"L_10_5_Ο
Ξ± π π c Ο' a = L_10_5_Ο
Ξ± π π c Ο'' a"
by (subst (asm) Ο'(2), use nothing in βΉsubst (asm) Ο''(2)βΊ)
(
cs_prems
cs_simp: Ο'Ο' Ο''Ο'' cat_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_lim_cs_intros cat_Kan_cs_intros cat_cs_intros
)
from this have Ο
Ο'a_Ο
Ο''a:
"L_10_5_Ο
Ξ± π π c Ο' aβ¦NTMapβ¦β¦bβ¦β¦ArrValβ¦β¦fβ¦ =
L_10_5_Ο
Ξ± π π c Ο'' aβ¦NTMapβ¦β¦bβ¦β¦ArrValβ¦β¦fβ¦"
if "b ββ©β π
β¦Objβ¦" and "f : c β¦βββ (πβ¦ObjMapβ¦β¦bβ¦)" for b f
by simp
have [cat_cs_simps]: "Ο'β¦NTMapβ¦β¦0, b, fβ¦β©β = Ο''β¦NTMapβ¦β¦0, b, fβ¦β©β"
if "b ββ©β π
β¦Objβ¦" and "f : c β¦βββ (πβ¦ObjMapβ¦β¦bβ¦)" for b f
using Ο
Ο'a_Ο
Ο''a[OF that] that
by
(
cs_prems
cs_simp: cat_Kan_cs_simps L_10_5_Ο
_arrow_ArrVal_app
cs_intro: cat_cs_intros
)
have
"ntcf_of_ntcf_arrow (c ββ©Cβ©F π) π Ο' =
ntcf_of_ntcf_arrow (c ββ©Cβ©F π) π Ο''"
proof(rule ntcf_eqI)
show "ntcf_of_ntcf_arrow (c ββ©Cβ©F π) π Ο' :
cf_const (c ββ©Cβ©F π) π a β¦β©Cβ©F π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π : c ββ©Cβ©F π β¦β¦β©CβΞ±β π"
by (rule Ο'.is_ntcf_axioms)
then have dom_lhs:
"πβ©β (ntcf_of_ntcf_arrow (c ββ©Cβ©F π) π Ο'β¦NTMapβ¦) = c ββ©Cβ©F πβ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps)
show "ntcf_of_ntcf_arrow (c ββ©Cβ©F π) π Ο'' :
cf_const (c ββ©Cβ©F π) π a β¦β©Cβ©F π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π : c ββ©Cβ©F π β¦β¦β©CβΞ±β π"
by (rule Ο''.is_ntcf_axioms)
then have dom_rhs:
"πβ©β (ntcf_of_ntcf_arrow (c ββ©Cβ©F π) π Ο''β¦NTMapβ¦) = c ββ©Cβ©F πβ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps)
show
"ntcf_of_ntcf_arrow (c ββ©Cβ©F π) π Ο'β¦NTMapβ¦ =
ntcf_of_ntcf_arrow (c ββ©Cβ©F π) π Ο''β¦NTMapβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix A assume "A ββ©β c ββ©Cβ©F πβ¦Objβ¦"
with assms(5) obtain b f
where A_def: "A = [0, b, f]β©β"
and b: "b ββ©β π
β¦Objβ¦"
and f: "f : c β¦βββ πβ¦ObjMapβ¦β¦bβ¦"
by auto
from b f show
"ntcf_of_ntcf_arrow (c ββ©Cβ©F π) π Ο'β¦NTMapβ¦β¦Aβ¦ =
ntcf_of_ntcf_arrow (c ββ©Cβ©F π) π Ο''β¦NTMapβ¦β¦Aβ¦"
unfolding A_def
by (cs_concl cs_simp: cat_cs_simps cat_FUNCT_cs_simps)
qed (cs_concl cs_intro: V_cs_intros)+
qed simp_all
then show "Ο' = Ο''"
proof(rule inj_onD[OF bij_betw_imp_inj_on[OF bij_betw_ntcf_of_ntcf_arrow]])
show "Ο' ββ©β ntcf_arrows Ξ± (c ββ©Cβ©F π) π"
by (subst Ο'(2))
(
cs_concl cs_intro:
cat_lim_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
show "Ο'' ββ©β ntcf_arrows Ξ± (c ββ©Cβ©F π) π"
by (subst Ο''(2))
(
cs_concl cs_intro:
cat_lim_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
qed
qed (cs_concl cs_intro: cat_Kan_cs_intros)
qed auto
qed
lemma L_10_5_Ο'_arrow_is_arr_isomorphism'[cat_Kan_cs_intros]:
assumes "π΅ Ξ²"
and "Ξ± ββ©β Ξ²"
and "π : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
and "π : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β π"
and "c ββ©β ββ¦Objβ¦"
and "a ββ©β πβ¦Objβ¦"
and "A = cf_Cone Ξ± Ξ² (π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π)β¦ObjMapβ¦β¦aβ¦"
and "B = L_10_5_N Ξ± Ξ² π π cβ¦ObjMapβ¦β¦aβ¦"
and "β' = cat_Set Ξ²"
shows "L_10_5_Ο'_arrow Ξ± Ξ² π π c a : A β¦β©iβ©sβ©oββ'β B"
using assms(1-6)
unfolding assms(7-9)
by (rule L_10_5_Ο'_arrow_is_arr_isomorphism)
lemma L_10_5_Ο'_arrow_is_arr:
assumes "π΅ Ξ²"
and "Ξ± ββ©β Ξ²"
and "π : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
and "π : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β π"
and "c ββ©β ββ¦Objβ¦"
and "a ββ©β πβ¦Objβ¦"
shows "L_10_5_Ο'_arrow Ξ± Ξ² π π c a :
cf_Cone Ξ± Ξ² (π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π)β¦ObjMapβ¦β¦aβ¦ β¦βcat_Set Ξ²β
L_10_5_N Ξ± Ξ² π π cβ¦ObjMapβ¦β¦aβ¦"
by
(
rule cat_Set_is_arr_isomorphismD(1)[
OF L_10_5_Ο'_arrow_is_arr_isomorphism[OF assms(1-6)]
]
)
lemma L_10_5_Ο'_arrow_is_arr'[cat_Kan_cs_intros]:
assumes "π΅ Ξ²"
and "Ξ± ββ©β Ξ²"
and "π : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
and "π : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β π"
and "c ββ©β ββ¦Objβ¦"
and "a ββ©β πβ¦Objβ¦"
and "A = cf_Cone Ξ± Ξ² (π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π)β¦ObjMapβ¦β¦aβ¦"
and "B = L_10_5_N Ξ± Ξ² π π cβ¦ObjMapβ¦β¦aβ¦"
and "β' = cat_Set Ξ²"
shows "L_10_5_Ο'_arrow Ξ± Ξ² π π c a : A β¦ββ'β B"
using assms(1-6) unfolding assms(7-9) by (rule L_10_5_Ο'_arrow_is_arr)
subsectionβΉLemma X.5: βΉL_10_5_ΟβΊ\label{sec:lem_X_5_end}βΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition L_10_5_Ο :: "V β V β V β V β V β V"
where "L_10_5_Ο Ξ± Ξ² π π c =
[
(Ξ»aββ©βπβ¦HomCodβ¦β¦Objβ¦. L_10_5_Ο'_arrow Ξ± Ξ² π π c a),
cf_Cone Ξ± Ξ² (π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π),
L_10_5_N Ξ± Ξ² π π c,
op_cat (πβ¦HomCodβ¦),
cat_Set Ξ²
]β©β"
textβΉComponents.βΊ
lemma L_10_5_Ο_components:
shows "L_10_5_Ο Ξ± Ξ² π π cβ¦NTMapβ¦ =
(Ξ»aββ©βπβ¦HomCodβ¦β¦Objβ¦. L_10_5_Ο'_arrow Ξ± Ξ² π π c a)"
and [cat_Kan_cs_simps]:
"L_10_5_Ο Ξ± Ξ² π π cβ¦NTDomβ¦ = cf_Cone Ξ± Ξ² (π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π)"
and [cat_Kan_cs_simps]:
"L_10_5_Ο Ξ± Ξ² π π cβ¦NTCodβ¦ = L_10_5_N Ξ± Ξ² π π c"
and "L_10_5_Ο Ξ± Ξ² π π cβ¦NTDGDomβ¦ = op_cat (πβ¦HomCodβ¦)"
and [cat_Kan_cs_simps]: "L_10_5_Ο Ξ± Ξ² π π cβ¦NTDGCodβ¦ = cat_Set Ξ²"
unfolding L_10_5_Ο_def nt_field_simps by (simp_all add: nat_omega_simps)
context
fixes Ξ± π π
π
assumes π: "π : π
β¦β¦β©CβΞ±β π"
begin
interpretation is_functor Ξ± π
π π by (rule π)
lemmas L_10_5_Ο_components' =
L_10_5_Ο_components[where π=π, unfolded cat_cs_simps]
lemmas [cat_Kan_cs_simps] = L_10_5_Ο_components'(4)
end
subsubsectionβΉNatural transformation mapβΊ
mk_VLambda L_10_5_Ο_components(1)
|vsv L_10_5_Ο_NTMap_vsv[cat_Kan_cs_intros]|
context
fixes Ξ± π π
π
assumes π: "π : π
β¦β¦β©CβΞ±β π"
begin
interpretation is_functor Ξ± π
π π by (rule π)
mk_VLambda L_10_5_Ο_components(1)[where π=π, unfolded cat_cs_simps]
|vdomain L_10_5_Ο_NTMap_vdomain[cat_Kan_cs_simps]|
|app L_10_5_Ο_NTMap_app[cat_Kan_cs_simps]|
end
subsubsectionβΉβΉL_10_5_ΟβΊ is a natural isomorphismβΊ
lemma L_10_5_Ο_is_iso_ntcf:
assumes "π΅ Ξ²"
and "Ξ± ββ©β Ξ²"
and "π : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
and "π : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β π"
and "c ββ©β ββ¦Objβ¦"
shows "L_10_5_Ο Ξ± Ξ² π π c :
cf_Cone Ξ± Ξ² (π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π) β¦β©Cβ©Fβ©.β©iβ©sβ©o L_10_5_N Ξ± Ξ² π π c :
op_cat π β¦β¦β©CβΞ²β cat_Set Ξ²"
(is βΉ?L_10_5_Ο : ?cf_Cone β¦β©Cβ©Fβ©.β©iβ©sβ©o ?L_10_5_N : op_cat π β¦β¦β©CβΞ²β cat_Set Ξ²βΊ)
proof-
let ?FUNCT = βΉΞ»π. cat_FUNCT Ξ± π (cat_Set Ξ±)βΊ
let ?cπ_π = βΉcat_Funct Ξ± (c ββ©Cβ©F π) πβΊ
let ?ntcf_cπ_π = βΉntcf_const (c ββ©Cβ©F π) πβΊ
let ?π_cπ = βΉπ ββ©Cβ©F c β©Oβ¨
β©Cβ©F πβΊ
let ?H_β = βΉΞ»c. Homβ©Oβ©.β©CβΞ±ββ(c,-)βΊ
let ?H_π = βΉΞ»a. Homβ©Oβ©.β©CβΞ±βπ(a,-)βΊ
let ?L_10_5_Ο'_arrow = βΉL_10_5_Ο'_arrow Ξ± Ξ² π π cβΊ
let ?cf_cπ_π = βΉcf_const (c ββ©Cβ©F π) πβΊ
let ?L_10_5_Ο
= βΉL_10_5_Ο
Ξ± π π cβΊ
let ?L_10_5_Ο
_arrow = βΉL_10_5_Ο
_arrow π π cβΊ
interpret Ξ²: π΅ Ξ² by (rule assms(1))
interpret π: is_tm_functor Ξ± π
β π by (rule assms(3))
interpret π: is_tm_functor Ξ± π
π π by (rule assms(4))
from π.vempty_is_zet assms(5) interpret cπ: tiny_category Ξ± βΉc ββ©Cβ©F πβΊ
by (cs_concl cs_intro: cat_comma_cs_intros)
from assms(2,5) interpret cπ_π: category Ξ± ?cπ_π
by
(
cs_concl cs_intro:
cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
interpret Ξ²_cπ_π: category Ξ² ?cπ_π
by (rule cπ_π.cat_category_if_ge_Limit)
(cs_concl cs_intro: cat_cs_intros assms(2))+
from assms(2,5) interpret Ξ: is_functor Ξ± π ?cπ_π βΉΞβ©C Ξ± (c ββ©Cβ©F π) πβΊ
by
(
cs_concl cs_intro:
cat_small_cs_intros cat_cs_intros cat_op_intros
)+
from Ξ.is_functor_axioms assms(2) interpret Ξ²Ξ:
is_functor Ξ² π ?cπ_π βΉΞβ©C Ξ± (c ββ©Cβ©F π) πβΊ
by (cs_intro_step is_functor.cf_is_functor_if_ge_Limit)
(cs_concl cs_intro: cat_cs_intros)+
from π.vempty_is_zet assms(5) interpret Ξ c:
is_tm_functor Ξ± βΉc ββ©Cβ©F πβΊ π
βΉc β©Oβ¨
β©Cβ©F πβΊ
by
(
cs_concl
cs_simp: cat_comma_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_comma_cs_intros
)
interpret Ξ²Ξ c: is_tiny_functor Ξ² βΉc ββ©Cβ©F πβΊ π
βΉc β©Oβ¨
β©Cβ©F πβΊ
by (rule Ξ c.cf_is_tiny_functor_if_ge_Limit[OF assms(1,2)])
interpret E: is_functor Ξ² βΉ?FUNCT β Γβ©C ββΊ βΉcat_Set Ξ²βΊ βΉcf_eval Ξ± Ξ² ββΊ
by (rule π.HomCod.cat_cf_eval_is_functor[OF assms(1,2)])
from assms(2) interpret FUNCT_π: tiny_category Ξ² βΉ?FUNCT πβΊ
by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
from assms(2) interpret FUNCT_π
: tiny_category Ξ² βΉ?FUNCT π
βΊ
by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
from assms(2) interpret FUNCT_β: tiny_category Ξ² βΉ?FUNCT ββΊ
by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
interpret Ξ²π: tiny_category Ξ² π
by (rule category.cat_tiny_category_if_ge_Limit)
(use assms(2) in βΉcs_concl cs_simp: cs_intro: cat_cs_introsβΊ)+
interpret Ξ²π
: tiny_category Ξ² π
by (rule category.cat_tiny_category_if_ge_Limit)
(use assms(2) in βΉcs_concl cs_simp: cs_intro: cat_cs_introsβΊ)+
interpret Ξ²β: tiny_category Ξ² β
by (rule category.cat_tiny_category_if_ge_Limit)
(use assms(2) in βΉcs_concl cs_simp: cs_intro: cat_cs_introsβΊ)+
interpret Ξ²π: is_tiny_functor Ξ² π
β π
by (rule is_functor.cf_is_tiny_functor_if_ge_Limit)
(use assms(2) in βΉcs_concl cs_simp: cs_intro: cat_cs_introsβΊ)+
interpret Ξ²π: is_tiny_functor Ξ² π
π π
by (rule is_functor.cf_is_tiny_functor_if_ge_Limit)
(use assms(2) in βΉcs_concl cs_simp: cs_intro: cat_cs_introsβΊ)+
interpret cat_Set_Ξ±Ξ²: subcategory Ξ² βΉcat_Set Ξ±βΊ βΉcat_Set Ξ²βΊ
by (rule π.subcategory_cat_Set_cat_Set[OF assms(1,2)])
show ?thesis
proof(intro is_iso_ntcfI is_ntcfI', unfold cat_op_simps)
show "vfsequence (?L_10_5_Ο)" unfolding L_10_5_Ο_def by auto
show "vcard (?L_10_5_Ο) = 5β©β"
unfolding L_10_5_Ο_def by (simp add: nat_omega_simps)
from assms(2) show "?cf_Cone : op_cat π β¦β¦β©CβΞ²β cat_Set Ξ²"
by (intro is_tm_functor.tm_cf_cf_Cone_is_functor_if_ge_Limit)
(cs_concl cs_intro: cat_small_cs_intros cat_cs_intros)+
from assms show "?L_10_5_N : op_cat π β¦β¦β©CβΞ²β cat_Set Ξ²"
by (cs_concl cs_intro: cat_Kan_cs_intros)
show "?L_10_5_Οβ¦NTMapβ¦β¦aβ¦ :
?cf_Coneβ¦ObjMapβ¦β¦aβ¦ β¦β©iβ©sβ©oβcat_Set Ξ²β ?L_10_5_Nβ¦ObjMapβ¦β¦aβ¦"
if "a ββ©β πβ¦Objβ¦" for a
using assms(2,3,4,5) that
by
(
cs_concl
cs_simp: L_10_5_Ο_NTMap_app
cs_intro: cat_cs_intros L_10_5_Ο'_arrow_is_arr_isomorphism
)
from cat_Set_is_arr_isomorphismD[OF this] show
"?L_10_5_Οβ¦NTMapβ¦β¦aβ¦ : ?cf_Coneβ¦ObjMapβ¦β¦aβ¦ β¦βcat_Set Ξ²β ?L_10_5_Nβ¦ObjMapβ¦β¦aβ¦"
if "a ββ©β πβ¦Objβ¦" for a
using that by auto
have [cat_cs_simps]:
"?L_10_5_Ο'_arrow b ββ©Aβcat_Set Ξ²β
cf_hom ?cπ_π [ntcf_arrow (?ntcf_cπ_π f), ntcf_arrow (ntcf_id ?π_cπ)]β©β =
cf_hom (?FUNCT π
)
[
ntcf_arrow (ntcf_id (?H_β c ββ©Cβ©F π)),
ntcf_arrow (Homβ©Aβ©.β©CβΞ±βπ(f,-) ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π)
]β©β ββ©Aβcat_Set Ξ²β ?L_10_5_Ο'_arrow a"
(
is
"?L_10_5_Ο'_arrow b ββ©Aβcat_Set Ξ²β ?cf_hom_lhs =
?cf_hom_rhs ββ©Aβcat_Set Ξ²β ?L_10_5_Ο'_arrow a"
)
if "f : b β¦βπβ a" for a b f
proof-
let ?H_f = βΉHomβ©Aβ©.β©CβΞ±βπ(f,-)βΊ
from that assms Ξ²_cπ_π.category_axioms cπ_π.category_axioms have lhs:
"?L_10_5_Ο'_arrow b ββ©Aβcat_Set Ξ²β ?cf_hom_lhs :
Hom ?cπ_π (cf_map (?cf_cπ_π a)) (cf_map ?π_cπ) β¦βcat_Set Ξ²β
?L_10_5_Nβ¦ObjMapβ¦β¦bβ¦"
by
(
cs_concl
cs_simp:
cat_Kan_cs_simps
cat_cs_simps
cat_FUNCT_cs_simps
cat_Funct_components(1)
cat_op_simps
cs_intro:
cat_Kan_cs_intros
cat_small_cs_intros
cat_FUNCT_cs_intros
cat_cs_intros
cat_prod_cs_intros
cat_op_intros
)
then have dom_lhs:
"πβ©β ((?L_10_5_Ο'_arrow b ββ©Aβcat_Set Ξ²β ?cf_hom_lhs)β¦ArrValβ¦) =
Hom ?cπ_π (cf_map (?cf_cπ_π a)) (cf_map ?π_cπ)"
by (cs_concl cs_simp: cat_cs_simps)
from that assms Ξ²_cπ_π.category_axioms cπ_π.category_axioms have rhs:
"?cf_hom_rhs ββ©Aβcat_Set Ξ²β ?L_10_5_Ο'_arrow a :
Hom ?cπ_π (cf_map (?cf_cπ_π a)) (cf_map ?π_cπ) β¦βcat_Set Ξ²β
?L_10_5_Nβ¦ObjMapβ¦β¦bβ¦"
by
(
cs_concl
cs_simp:
cat_Kan_cs_simps
cat_cs_simps
cat_Funct_components(1)
cat_op_simps
cs_intro:
cat_Kan_cs_intros
cat_small_cs_intros
cat_cs_intros
cat_prod_cs_intros
cat_FUNCT_cs_intros
cat_op_intros
)
then have dom_rhs:
"πβ©β ((?cf_hom_rhs ββ©Aβcat_Set Ξ²β ?L_10_5_Ο'_arrow a)β¦ArrValβ¦) =
Hom ?cπ_π (cf_map (?cf_cπ_π a)) (cf_map ?π_cπ)"
by (cs_concl cs_simp: cat_cs_simps)
show ?thesis
proof(rule arr_Set_eqI)
from lhs show arr_Set_lhs:
"arr_Set Ξ² (?L_10_5_Ο'_arrow b ββ©Aβcat_Set Ξ²β ?cf_hom_lhs)"
by (auto dest: cat_Set_is_arrD(1))
from rhs show arr_Set_rhs:
"arr_Set Ξ² (?cf_hom_rhs ββ©Aβcat_Set Ξ²β ?L_10_5_Ο'_arrow a)"
by (auto dest: cat_Set_is_arrD(1))
show
"(?L_10_5_Ο'_arrow b ββ©Aβcat_Set Ξ²β ?cf_hom_lhs)β¦ArrValβ¦ =
(?cf_hom_rhs ββ©Aβcat_Set Ξ²β ?L_10_5_Ο'_arrow a)β¦ArrValβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
fix F assume prems: "F : cf_map (?cf_cπ_π a) β¦β?cπ_πβ cf_map ?π_cπ"
let ?F = βΉntcf_of_ntcf_arrow (c ββ©Cβ©F π) π FβΊ
from that have [cat_cs_simps]:
"cf_of_cf_map (c ββ©Cβ©F π) π (cf_map (?cf_cπ_π a)) = ?cf_cπ_π a"
"cf_of_cf_map (c ββ©Cβ©F π) π (cf_map (?π_cπ)) = ?π_cπ"
by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
note F = cat_Funct_is_arrD[OF prems, unfolded cat_cs_simps]
from that F(1) have F_const_is_cat_cone:
"?F ββ©Nβ©Tβ©Cβ©F ?ntcf_cπ_π f : b <β©Cβ©Fβ©.β©cβ©oβ©nβ©e ?π_cπ : c ββ©Cβ©F π β¦β¦β©CβΞ±β π"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_small_cs_intros is_cat_coneI cat_cs_intros
)
have [cat_cs_simps]:
"?L_10_5_Ο
(ntcf_arrow (?F ββ©Nβ©Tβ©Cβ©F ?ntcf_cπ_π f)) b =
?H_f ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π ββ©Nβ©Tβ©Cβ©F ?L_10_5_Ο
(ntcf_arrow ?F) a"
proof(rule ntcf_eqI)
from assms that F(1) show
"?L_10_5_Ο
(ntcf_arrow (?F ββ©Nβ©Tβ©Cβ©F ?ntcf_cπ_π f)) b :
?H_β c ββ©Cβ©F π β¦β©Cβ©F ?H_π b ββ©Cβ©F π : π
β¦β¦β©CβΞ±β cat_Set Ξ±"
by
(
cs_concl cs_intro:
cat_small_cs_intros
cat_Kan_cs_intros
cat_cs_intros
is_cat_coneI
)
then have dom_Ο
:
"πβ©β (?L_10_5_Ο
(ntcf_arrow (?F ββ©Nβ©Tβ©Cβ©F ?ntcf_cπ_π f)) bβ¦NTMapβ¦) =
π
β¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps)
from assms that F(1) show
"?H_f ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π ββ©Nβ©Tβ©Cβ©F ?L_10_5_Ο
(ntcf_arrow ?F) a :
?H_β c ββ©Cβ©F π β¦β©Cβ©F ?H_π b ββ©Cβ©F π : π
β¦β¦β©CβΞ±β cat_Set Ξ±"
by
(
cs_concl cs_intro:
cat_Kan_cs_intros cat_cs_intros is_cat_coneI
)
then have dom_fπΟ
:
"πβ©β ((?H_f ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π ββ©Nβ©Tβ©Cβ©F ?L_10_5_Ο
(ntcf_arrow ?F) a)β¦NTMapβ¦) =
π
β¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps)
show
"?L_10_5_Ο
(ntcf_arrow (?F ββ©Nβ©Tβ©Cβ©F ?ntcf_cπ_π f)) bβ¦NTMapβ¦ =
(?H_f ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π ββ©Nβ©Tβ©Cβ©F ?L_10_5_Ο
(ntcf_arrow ?F) a)β¦NTMapβ¦"
proof(rule vsv_eqI, unfold dom_Ο
dom_fπΟ
)
fix b' assume prems': "b' ββ©β π
β¦Objβ¦"
let ?Y = βΉYoneda_component (?H_π b) a f (πβ¦ObjMapβ¦β¦b'β¦)βΊ
let ?πb' = βΉπβ¦ObjMapβ¦β¦b'β¦βΊ
let ?πb' = βΉπβ¦ObjMapβ¦β¦b'β¦βΊ
have [cat_cs_simps]:
"?L_10_5_Ο
_arrow (ntcf_arrow (?F ββ©Nβ©Tβ©Cβ©F ?ntcf_cπ_π f)) b b' =
?Y ββ©Aβcat_Set Ξ±β ?L_10_5_Ο
_arrow (ntcf_arrow ?F) a b'"
(is βΉ?Ο
_Ffbb' = ?YΟ
βΊ)
proof-
from assms prems' F_const_is_cat_cone have Ο
_Ffbb':
"?Ο
_Ffbb' : Hom β c ?πb' β¦βcat_Set Ξ±β Hom π b ?πb'"
by
(
cs_concl cs_intro:
cat_cs_intros L_10_5_Ο
_arrow_is_arr
)
then have dom_Ο
_Ffbb': "πβ©β (?Ο
_Ffbb'β¦ArrValβ¦) = Hom β c (?πb')"
by (cs_concl cs_simp: cat_cs_simps)
from assms that π.HomCod.category_axioms prems' F(1) have YΟ
:
"?YΟ
: Hom β c ?πb' β¦βcat_Set Ξ±β Hom π b ?πb'"
by
(
cs_concl
cs_simp: cat_Kan_cs_simps cat_cs_simps cat_op_simps
cs_intro: is_cat_coneI cat_Kan_cs_intros cat_cs_intros
)
then have dom_YΟ
: "πβ©β (?YΟ
β¦ArrValβ¦) = Hom β c (?πb')"
by (cs_concl cs_simp: cat_cs_simps)
show ?thesis
proof(rule arr_Set_eqI)
from Ο
_Ffbb' show arr_Set_Ο
_Ffbb': "arr_Set Ξ± ?Ο
_Ffbb'"
by (auto dest: cat_Set_is_arrD(1))
from YΟ
show arr_Set_YΟ
: "arr_Set Ξ± ?YΟ
"
by (auto dest: cat_Set_is_arrD(1))
show "?Ο
_Ffbb'β¦ArrValβ¦ = ?YΟ
β¦ArrValβ¦"
proof(rule vsv_eqI, unfold dom_Ο
_Ffbb' dom_YΟ
in_Hom_iff)
fix g assume "g : c β¦βββ ?πb'"
with
assms(2-)
π.is_functor_axioms
π.is_functor_axioms
π.HomCod.category_axioms
π.HomCod.category_axioms
that prems' F(1)
show "?Ο
_Ffbb'β¦ArrValβ¦β¦gβ¦ = ?YΟ
β¦ArrValβ¦β¦gβ¦"
by
(
cs_concl
cs_simp:
cat_Kan_cs_simps
cat_cs_simps
L_10_5_Ο
_arrow_ArrVal_app
cat_comma_cs_simps
cat_op_simps
cs_intro:
cat_Kan_cs_intros
is_cat_coneI
cat_cs_intros
cat_comma_cs_intros
cat_op_intros
cs_simp: cat_FUNCT_cs_simps
cs_intro: cat_small_cs_intros
)
qed (use arr_Set_Ο
_Ffbb' arr_Set_YΟ
in auto)
qed (use Ο
_Ffbb' YΟ
in βΉcs_concl cs_simp: cat_cs_simpsβΊ)+
qed
from assms prems' that F(1) show
"?L_10_5_Ο
(ntcf_arrow (?F ββ©Nβ©Tβ©Cβ©F ?ntcf_cπ_π f)) bβ¦NTMapβ¦β¦b'β¦ =
(?H_f ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π ββ©Nβ©Tβ©Cβ©F ?L_10_5_Ο
(ntcf_arrow ?F) a)β¦NTMapβ¦β¦b'β¦"
by
(
cs_concl
cs_simp: cat_Kan_cs_simps cat_cs_simps
cs_intro: is_cat_coneI cat_Kan_cs_intros cat_cs_intros
)
qed (cs_concl cs_intro: cat_Kan_cs_intros cat_cs_intros)+
qed simp_all
from that F(1) interpret F: is_cat_cone Ξ± a βΉc ββ©Cβ©F πβΊ π βΉ?π_cπβΊ ?F
by (cs_concl cs_intro: is_cat_coneI cat_cs_intros)
from
assms(2-) prems F(1) that
π.HomCod.cat_ntcf_Hom_snd_is_ntcf[OF that]
Ξ²_cπ_π.category_axioms
show
"(?L_10_5_Ο'_arrow b ββ©Aβcat_Set Ξ²β ?cf_hom_lhs)β¦ArrValβ¦β¦Fβ¦ =
(?cf_hom_rhs ββ©Aβcat_Set Ξ²β ?L_10_5_Ο'_arrow a)β¦ArrValβ¦β¦Fβ¦"
by (subst (1 2) F(2))
(
cs_concl
cs_simp:
cat_cs_simps
cat_Kan_cs_simps
cat_FUNCT_cs_simps
cat_Funct_components(1)
cat_op_simps
cs_intro:
cat_small_cs_intros
is_cat_coneI
cat_Kan_cs_intros
cat_cs_intros
cat_prod_cs_intros
cat_FUNCT_cs_intros
cat_op_intros
)
qed (use arr_Set_lhs arr_Set_rhs in auto)
qed (use lhs rhs in βΉcs_concl cs_simp: cat_cs_simpsβΊ)+
qed
show
"?L_10_5_Οβ¦NTMapβ¦β¦bβ¦ ββ©Aβcat_Set Ξ²β ?cf_Coneβ¦ArrMapβ¦β¦fβ¦ =
?L_10_5_Nβ¦ArrMapβ¦β¦fβ¦ ββ©Aβcat_Set Ξ²β ?L_10_5_Οβ¦NTMapβ¦β¦aβ¦"
if "f : b β¦βπβ a" for a b f
using that assms
by
(
cs_concl
cs_simp:
cat_cs_simps
cat_Kan_cs_simps
cat_Funct_components(1)
cat_FUNCT_cs_simps
cat_op_simps
cs_intro:
cat_small_cs_intros
cat_Kan_cs_intros
cat_cs_intros
cat_FUNCT_cs_intros
cat_op_intros
)
qed
(
cs_concl
cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros cat_Kan_cs_intros
)+
qed
subsectionβΉ
The limit of βΉπ ββ©Cβ©F c β©Oβ¨
β©Cβ©F πβΊ exists for every
pointwise right Kan extension of βΉπβΊ along βΉπβΊ
βΊ
lemma (in is_cat_pw_rKe) cat_pw_rKe_ex_cat_limit:
assumes "π : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
and "π : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β π"
and "c ββ©β ββ¦Objβ¦"
obtains UA
where "UA : πβ¦ObjMapβ¦β¦cβ¦ <β©Cβ©Fβ©.β©lβ©iβ©m π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π : c ββ©Cβ©F π β¦β¦β©CβΞ±β π"
proof-
define Ξ² where "Ξ² = Ξ± + Ο"
have Ξ²: "π΅ Ξ²" and Ξ±Ξ²: "Ξ± ββ©β Ξ²"
by (simp_all add: Ξ²_def AG.π΅_Limit_Ξ±Ο AG.π΅_Ο_Ξ±Ο π΅_def AG.π΅_Ξ±_Ξ±Ο)
then interpret Ξ²: π΅ Ξ² by simp
let ?FUNCT = βΉΞ»π. cat_FUNCT Ξ± π (cat_Set Ξ±)βΊ
let ?H_A = βΉΞ»f. Homβ©Aβ©.β©CβΞ±βπ(f,-)βΊ
let ?H_Aπ = βΉΞ»f. ?H_A f ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F πβΊ
let ?H_π = βΉΞ»a. Homβ©Oβ©.β©CβΞ±βπ(a,-)βΊ
let ?H_ππ = βΉΞ»a. ?H_π a ββ©Cβ©F πβΊ
let ?H_ππ = βΉΞ»a. ?H_π a ββ©Cβ©F πβΊ
let ?H_β = βΉΞ»c. Homβ©Oβ©.β©CβΞ±ββ(c,-)βΊ
let ?H_βπ = βΉΞ»c. ?H_β c ββ©Cβ©F πβΊ
let ?H_πΞ΅ = βΉΞ»b. ?H_π b ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F Ξ΅βΊ
let ?SET_π = βΉexp_cat_cf Ξ± (cat_Set Ξ±) πβΊ
let ?H_FUNCT = βΉΞ»β π. Homβ©Oβ©.β©CβΞ²β?FUNCT β(-,cf_map π)βΊ
let ?ua_NTDGDom = βΉop_cat (?FUNCT β)βΊ
let ?ua_NTDom = βΉΞ»a. ?H_FUNCT β (?H_ππ a)βΊ
let ?ua_NTCod = βΉΞ»a. ?H_FUNCT π
(?H_ππ a) ββ©Cβ©F op_cf ?SET_πβΊ
let ?cπ_π = βΉcat_Funct Ξ± (c ββ©Cβ©F π) πβΊ
let ?ua =
βΉ
Ξ»a. ntcf_ua_fo
Ξ²
?SET_π
(cf_map (?H_ππ a))
(cf_map (?H_ππ a))
(ntcf_arrow (?H_πΞ΅ a))
βΊ
let ?cf_nt = βΉcf_nt Ξ± Ξ² (cf_id β)βΊ
let ?cf_eval = βΉcf_eval Ξ± Ξ² ββΊ
let ?π_cπ = βΉπ ββ©Cβ©F c β©Oβ¨
β©Cβ©F πβΊ
let ?cf_cπ_π = βΉcf_const (c ββ©Cβ©F π) πβΊ
let ?πc = βΉπβ¦ObjMapβ¦β¦cβ¦βΊ
let ?Ξ = βΉΞβ©C Ξ± (c ββ©Cβ©F π) πβΊ
let ?ntcf_ua_fo =
βΉ
Ξ»a. ntcf_ua_fo
Ξ²
?SET_π
(cf_map (?H_ππ a))
(cf_map (?H_ππ a))
(ntcf_arrow (?H_πΞ΅ a))
βΊ
let ?umap_fo =
βΉ
Ξ»b. umap_fo
?SET_π
(cf_map (?H_ππ b))
(cf_map (?H_ππ b))
(ntcf_arrow (?H_πΞ΅ b))
(cf_map (?H_β c))
βΊ
interpret π: is_tm_functor Ξ± π
β π by (rule assms(1))
interpret π: is_tm_functor Ξ± π
π π by (rule assms(2))
from AG.vempty_is_zet assms(3) interpret cπ: tiny_category Ξ± βΉc ββ©Cβ©F πβΊ
by (cs_concl cs_intro: cat_comma_cs_intros)
from Ξ±Ξ² assms(3) interpret cπ_π: category Ξ± ?cπ_π
by
(
cs_concl cs_intro:
cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
interpret Ξ²_cπ_π: category Ξ² ?cπ_π
by (rule cπ_π.cat_category_if_ge_Limit)
(cs_concl cs_intro: cat_cs_intros Ξ±Ξ²)+
from Ξ±Ξ² assms(3) interpret Ξ: is_functor Ξ± π ?cπ_π ?Ξ
by
(
cs_concl cs_intro:
cat_small_cs_intros cat_cs_intros cat_op_intros
)+
from Ξ.is_functor_axioms Ξ±Ξ² interpret Ξ²Ξ:
is_functor Ξ² π βΉ?cπ_πβΊ βΉ?ΞβΊ
by (cs_intro_step is_functor.cf_is_functor_if_ge_Limit)
(cs_concl cs_intro: cat_cs_intros)+
from AG.vempty_is_zet assms(3) interpret Ξ c:
is_tm_functor Ξ± βΉc ββ©Cβ©F πβΊ π
βΉc β©Oβ¨
β©Cβ©F πβΊ
by
(
cs_concl
cs_simp: cat_comma_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_comma_cs_intros
)
interpret Ξ²Ξ c: is_tiny_functor Ξ² βΉc ββ©Cβ©F πβΊ π
βΉc β©Oβ¨
β©Cβ©F πβΊ
by (rule Ξ c.cf_is_tiny_functor_if_ge_Limit[OF Ξ² Ξ±Ξ²])
interpret E: is_functor Ξ² βΉ?FUNCT β Γβ©C ββΊ βΉcat_Set Ξ²βΊ ?cf_eval
by (rule AG.HomCod.cat_cf_eval_is_functor[OF Ξ² Ξ±Ξ²])
from Ξ±Ξ² interpret FUNCT_π: tiny_category Ξ² βΉ?FUNCT πβΊ
by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
from Ξ±Ξ² interpret FUNCT_π
: tiny_category Ξ² βΉ?FUNCT π
βΊ
by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
from Ξ±Ξ² interpret FUNCT_β: tiny_category Ξ² βΉ?FUNCT ββΊ
by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
interpret Ξ²π: tiny_category Ξ² π
by (rule category.cat_tiny_category_if_ge_Limit)
(use Ξ±Ξ² in βΉcs_concl cs_intro: cat_cs_introsβΊ)+
interpret Ξ²π
: tiny_category Ξ² π
by (rule category.cat_tiny_category_if_ge_Limit)
(use Ξ±Ξ² in βΉcs_concl cs_intro: cat_cs_introsβΊ)+
interpret Ξ²β: tiny_category Ξ² β
by (rule category.cat_tiny_category_if_ge_Limit)
(use Ξ±Ξ² in βΉcs_concl cs_intro: cat_cs_introsβΊ)+
interpret Ξ²π: is_tiny_functor Ξ² π
β π
by (rule is_functor.cf_is_tiny_functor_if_ge_Limit)
(use Ξ±Ξ² in βΉcs_concl cs_intro: cat_cs_introsβΊ)+
interpret Ξ²π: is_tiny_functor Ξ² β π π
by (rule is_functor.cf_is_tiny_functor_if_ge_Limit)
(use Ξ±Ξ² in βΉcs_concl cs_intro: cat_cs_introsβΊ)+
interpret Ξ²π: is_tiny_functor Ξ² π
π π
by (rule is_functor.cf_is_tiny_functor_if_ge_Limit)
(use Ξ±Ξ² in βΉcs_concl cs_intro: cat_cs_introsβΊ)+
interpret cat_Set_Ξ±Ξ²: subcategory Ξ² βΉcat_Set Ξ±βΊ βΉcat_Set Ξ²βΊ
by (rule AG.subcategory_cat_Set_cat_Set[OF Ξ² Ξ±Ξ²])
from assms(3) Ξ±Ξ² interpret Hom_c: is_functor Ξ± β βΉcat_Set Ξ±βΊ βΉ?H_β cβΊ
by (cs_concl cs_intro: cat_cs_intros)
define E' :: V where "E' =
[
(Ξ»aββ©βπβ¦Objβ¦. ?cf_evalβ¦ObjMapβ¦β¦cf_map (?H_ππ a), cβ¦β©β),
(Ξ»fββ©βπβ¦Arrβ¦. ?cf_evalβ¦ArrMapβ¦β¦ntcf_arrow (?H_Aπ f), ββ¦CIdβ¦β¦cβ¦β¦β©β),
op_cat π,
cat_Set Ξ²
]β©β "
have E'_components:
"E'β¦ObjMapβ¦ = (Ξ»aββ©βπβ¦Objβ¦. ?cf_evalβ¦ObjMapβ¦β¦cf_map (?H_ππ a), cβ¦β©β)"
"E'β¦ArrMapβ¦ =
(Ξ»fββ©βπβ¦Arrβ¦. ?cf_evalβ¦ArrMapβ¦β¦ntcf_arrow (?H_Aπ f), ββ¦CIdβ¦β¦cβ¦β¦β©β)"
"E'β¦HomDomβ¦ = op_cat π"
"E'β¦HomCodβ¦ = cat_Set Ξ²"
unfolding E'_def dghm_field_simps by (simp_all add: nat_omega_simps)
note [cat_cs_simps] = E'_components(3,4)
have E'_ObjMap_app[cat_cs_simps]:
"E'β¦ObjMapβ¦β¦aβ¦ = ?cf_evalβ¦ObjMapβ¦β¦cf_map (?H_ππ a), cβ¦β©β"
if "a ββ©β πβ¦Objβ¦" for a
using that unfolding E'_components by simp
have E'_ArrMap_app[cat_cs_simps]:
"E'β¦ArrMapβ¦β¦fβ¦ = ?cf_evalβ¦ArrMapβ¦β¦ntcf_arrow (?H_Aπ f), ββ¦CIdβ¦β¦cβ¦β¦β©β"
if "f ββ©β πβ¦Arrβ¦" for f
using that unfolding E'_components by simp
have E': "E' : op_cat π β¦β¦β©CβΞ²β cat_Set Ξ²"
proof(intro is_functorI')
show "vfsequence E'" unfolding E'_def by auto
show "vcard E' = 4β©β" unfolding E'_def by (simp add: nat_omega_simps)
show "vsv (E'β¦ObjMapβ¦)" unfolding E'_components by simp
show "vsv (E'β¦ArrMapβ¦)" unfolding E'_components by simp
show "πβ©β (E'β¦ObjMapβ¦) = op_cat πβ¦Objβ¦"
unfolding E'_components by (simp add: cat_op_simps)
show "ββ©β (E'β¦ObjMapβ¦) ββ©β cat_Set Ξ²β¦Objβ¦"
unfolding E'_components
proof(rule vrange_VLambda_vsubset)
fix a assume prems: "a ββ©β πβ¦Objβ¦"
then have "?H_ππ a : β β¦β¦β©CβΞ±β cat_Set Ξ±"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
with assms(3) prems show
"?cf_evalβ¦ObjMapβ¦β¦cf_map (?H_ππ a), cβ¦β©β ββ©β cat_Set Ξ²β¦Objβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps cat_Set_components(1)
cs_intro: cat_cs_intros cat_op_intros Ran.HomCod.cat_Hom_in_Vset
)
qed
show "πβ©β (E'β¦ArrMapβ¦) = op_cat πβ¦Arrβ¦"
unfolding E'_components by (simp add: cat_op_simps)
show "E'β¦ArrMapβ¦β¦fβ¦ : E'β¦ObjMapβ¦β¦aβ¦ β¦βcat_Set Ξ²β E'β¦ObjMapβ¦β¦bβ¦"
if "f : a β¦βop_cat πβ b" for a b f
proof-
from that[unfolded cat_op_simps] assms(3) show ?thesis
by (intro cat_Set_Ξ±Ξ².subcat_is_arrD)
(
cs_concl
cs_simp:
category.cf_eval_ObjMap_app
category.cf_eval_ArrMap_app
E'_ObjMap_app
E'_ArrMap_app
cs_intro: cat_cs_intros
)
qed
then have [cat_cs_intros]: "E'β¦ArrMapβ¦β¦fβ¦ : A β¦βcat_Set Ξ²β B"
if "A = E'β¦ObjMapβ¦β¦aβ¦" and "B = E'β¦ObjMapβ¦β¦bβ¦" and "f : b β¦βπβ a"
for a b f A B
using that by (simp add: cat_op_simps)
show
"E'β¦ArrMapβ¦β¦g ββ©Aβop_cat πβ fβ¦ = E'β¦ArrMapβ¦β¦gβ¦ ββ©Aβcat_Set Ξ²β E'β¦ArrMapβ¦β¦fβ¦"
if "g : b β¦βop_cat πβ c" and "f : a β¦βop_cat πβ b" for b c g a f
proof-
note g = that(1)[unfolded cat_op_simps]
and f = that(2)[unfolded cat_op_simps]
from g f assms(3) Ξ±Ξ² show ?thesis
by
(
cs_concl
cs_intro:
cat_small_cs_intros
cat_cs_intros
cat_prod_cs_intros
cat_FUNCT_cs_intros
cat_op_intros
cs_simp:
cat_cs_simps
cat_FUNCT_cs_simps
cat_prod_cs_simps
cat_op_simps
E.cf_ArrMap_Comp[symmetric]
)+
qed
show "E'β¦ArrMapβ¦β¦op_cat πβ¦CIdβ¦β¦aβ¦β¦ = cat_Set Ξ²β¦CIdβ¦β¦E'β¦ObjMapβ¦β¦aβ¦β¦"
if "a ββ©β op_cat πβ¦Objβ¦" for a
proof(cs_concl_step cat_Set_Ξ±Ξ².subcat_CId[symmetric])
from that[unfolded cat_op_simps] assms(3) show
"E'β¦ObjMapβ¦β¦aβ¦ ββ©β cat_Set Ξ±β¦Objβ¦"
by
(
cs_concl
cs_simp: cat_Set_components(1) cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros
)
from that[unfolded cat_op_simps] assms(3) show
"E'β¦ArrMapβ¦β¦op_cat πβ¦CIdβ¦β¦aβ¦β¦ = cat_Set Ξ±β¦CIdβ¦β¦E'β¦ObjMapβ¦β¦aβ¦β¦"
by
(
cs_concl
cs_intro: cat_cs_intros
cs_simp:
cat_Set_components(1)
cat_cs_simps
cat_op_simps
ntcf_id_cf_comp[symmetric]
)
qed
qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
then interpret E': is_functor Ξ² βΉop_cat πβΊ βΉcat_Set Ξ²βΊ E' by simp
define N' :: V where "N' =
[
(Ξ»aββ©βπβ¦Objβ¦. ?cf_ntβ¦ObjMapβ¦β¦cf_map (?H_ππ a), cβ¦β©β),
(Ξ»fββ©βπβ¦Arrβ¦. ?cf_ntβ¦ArrMapβ¦β¦ntcf_arrow (?H_Aπ f), ββ¦CIdβ¦β¦cβ¦β¦β©β),
op_cat π,
cat_Set Ξ²
]β©β "
have N'_components:
"N'β¦ObjMapβ¦ = (Ξ»aββ©βπβ¦Objβ¦. ?cf_ntβ¦ObjMapβ¦β¦cf_map (?H_ππ a), cβ¦β©β)"
"N'β¦ArrMapβ¦ =
(Ξ»fββ©βπβ¦Arrβ¦. ?cf_ntβ¦ArrMapβ¦β¦ntcf_arrow (?H_Aπ f), ββ¦CIdβ¦β¦cβ¦β¦β©β)"
"N'β¦HomDomβ¦ = op_cat π"
"N'β¦HomCodβ¦ = cat_Set Ξ²"
unfolding N'_def dghm_field_simps by (simp_all add: nat_omega_simps)
note [cat_cs_simps] = N'_components(3,4)
have N'_ObjMap_app[cat_cs_simps]:
"N'β¦ObjMapβ¦β¦aβ¦ = ?cf_ntβ¦ObjMapβ¦β¦cf_map (?H_ππ a), cβ¦β©β"
if "a ββ©β πβ¦Objβ¦" for a
using that unfolding N'_components by simp
have N'_ArrMap_app[cat_cs_simps]:
"N'β¦ArrMapβ¦β¦fβ¦ = ?cf_ntβ¦ArrMapβ¦β¦ntcf_arrow (?H_Aπ f), ββ¦CIdβ¦β¦cβ¦β¦β©β"
if "f ββ©β πβ¦Arrβ¦" for f
using that unfolding N'_components by simp
from Ξ±Ξ² interpret cf_nt_β: is_functor Ξ² βΉ?FUNCT β Γβ©C ββΊ βΉcat_Set Ξ²βΊ βΉ?cf_ntβΊ
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
have N': "N' : op_cat π β¦β¦β©CβΞ²β cat_Set Ξ²"
proof(intro is_functorI')
show "vfsequence N'" unfolding N'_def by simp
show "vcard N' = 4β©β" unfolding N'_def by (simp add: nat_omega_simps)
show "vsv (N'β¦ObjMapβ¦)" unfolding N'_components by simp
show "vsv (N'β¦ArrMapβ¦)" unfolding N'_components by simp
show "πβ©β (N'β¦ObjMapβ¦) = op_cat πβ¦Objβ¦"
unfolding N'_components by (simp add: cat_op_simps)
show "ββ©β (N'β¦ObjMapβ¦) ββ©β cat_Set Ξ²β¦Objβ¦"
unfolding N'_components
proof(rule vrange_VLambda_vsubset)
fix a assume prems: "a ββ©β πβ¦Objβ¦"
with assms(3) Ξ±Ξ² show
"?cf_ntβ¦ObjMapβ¦β¦cf_map (?H_ππ a), cβ¦β©β ββ©β cat_Set Ξ²β¦Objβ¦"
by
(
cs_concl
cs_simp: cat_Set_components(1) cat_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_cs_intros FUNCT_β.cat_Hom_in_Vset cat_FUNCT_cs_intros
)
qed
show "πβ©β (N'β¦ArrMapβ¦) = op_cat πβ¦Arrβ¦"
unfolding N'_components by (simp add: cat_op_simps)
show "N'β¦ArrMapβ¦β¦fβ¦ : N'β¦ObjMapβ¦β¦aβ¦ β¦βcat_Set Ξ²β N'β¦ObjMapβ¦β¦bβ¦"
if "f : a β¦βop_cat πβ b" for a b f
using that[unfolded cat_op_simps] assms(3)
by
(
cs_concl
cs_simp: N'_ObjMap_app N'_ArrMap_app
cs_intro: cat_cs_intros cat_prod_cs_intros cat_FUNCT_cs_intros
)
show
"N'β¦ArrMapβ¦β¦g ββ©Aβop_cat πβ fβ¦ = N'β¦ArrMapβ¦β¦gβ¦ ββ©Aβcat_Set Ξ²β N'β¦ArrMapβ¦β¦fβ¦"
if "g : b β¦βop_cat πβ c" and "f : a β¦βop_cat πβ b" for b c g a f
proof-
from that assms(3) Ξ±Ξ² show ?thesis
unfolding cat_op_simps
by
(
cs_concl
cs_intro:
cat_cs_intros
cat_prod_cs_intros
cat_FUNCT_cs_intros
cat_op_intros
cs_simp:
cat_cs_simps
cat_FUNCT_cs_simps
cat_prod_cs_simps
cat_op_simps
cf_nt_β.cf_ArrMap_Comp[symmetric]
)
qed
show "N'β¦ArrMapβ¦β¦op_cat πβ¦CIdβ¦β¦aβ¦β¦ = cat_Set Ξ²β¦CIdβ¦β¦N'β¦ObjMapβ¦β¦aβ¦β¦"
if "a ββ©β op_cat πβ¦Objβ¦" for a
proof-
note [cat_cs_simps] =
ntcf_id_cf_comp[symmetric]
ntcf_arrow_id_ntcf_id[symmetric]
cat_FUNCT_CId_app[symmetric]
from that[unfolded cat_op_simps] assms(3) Ξ±Ξ² show ?thesis
by
(
cs_concl
cs_intro:
cat_cs_intros
cat_FUNCT_cs_intros
cat_prod_cs_intros
cat_op_intros
cs_simp: cat_FUNCT_cs_simps cat_cs_simps cat_op_simps
)+
qed
qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
then interpret N': is_functor Ξ² βΉop_cat πβΊ βΉcat_Set Ξ²βΊ N' by simp
define Y' :: V where "Y' =
[
(Ξ»aββ©βπβ¦Objβ¦. ntcf_Yoneda Ξ± Ξ² ββ¦NTMapβ¦β¦cf_map (?H_ππ a), cβ¦β©β),
N',
E',
op_cat π,
cat_Set Ξ²
]β©β"
have Y'_components:
"Y'β¦NTMapβ¦ = (Ξ»aββ©βπβ¦Objβ¦. ntcf_Yoneda Ξ± Ξ² ββ¦NTMapβ¦β¦cf_map (?H_ππ a), cβ¦β©β)"
"Y'β¦NTDomβ¦ = N'"
"Y'β¦NTCodβ¦ = E'"
"Y'β¦NTDGDomβ¦ = op_cat π"
"Y'β¦NTDGCodβ¦ = cat_Set Ξ²"
unfolding Y'_def nt_field_simps by (simp_all add: nat_omega_simps)
note [cat_cs_simps] = Y'_components(2-5)
have Y'_NTMap_app[cat_cs_simps]:
"Y'β¦NTMapβ¦β¦aβ¦ = ntcf_Yoneda Ξ± Ξ² ββ¦NTMapβ¦β¦cf_map (?H_ππ a), cβ¦β©β"
if "a ββ©β πβ¦Objβ¦" for a
using that unfolding Y'_components by simp
from Ξ² Ξ±Ξ² interpret Y:
is_iso_ntcf Ξ² βΉ?FUNCT β Γβ©C ββΊ βΉcat_Set Ξ²βΊ ?cf_nt ?cf_eval βΉntcf_Yoneda Ξ± Ξ² ββΊ
by (rule AG.HomCod.cat_ntcf_Yoneda_is_ntcf)
have Y': "Y' : N' β¦β©Cβ©Fβ©.β©iβ©sβ©o E' : op_cat π β¦β¦β©CβΞ²β cat_Set Ξ²"
proof(intro is_iso_ntcfI is_ntcfI')
show "vfsequence Y'" unfolding Y'_def by simp
show "vcard Y' = 5β©β"
unfolding Y'_def by (simp add: nat_omega_simps)
show "vsv (Y'β¦NTMapβ¦)" unfolding Y'_components by auto
show "πβ©β (Y'β¦NTMapβ¦) = op_cat πβ¦Objβ¦"
unfolding Y'_components by (simp add: cat_op_simps)
show Y'_NTMap_a: "Y'β¦NTMapβ¦β¦aβ¦ : N'β¦ObjMapβ¦β¦aβ¦ β¦β©iβ©sβ©oβcat_Set Ξ²β E'β¦ObjMapβ¦β¦aβ¦"
if "a ββ©β op_cat πβ¦Objβ¦" for a
using that[unfolded cat_op_simps] assms(3)
by
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps
cs_intro:
cat_arrow_cs_intros
cat_cs_intros
cat_prod_cs_intros
cat_FUNCT_cs_intros
)
then show "Y'β¦NTMapβ¦β¦aβ¦ : N'β¦ObjMapβ¦β¦aβ¦ β¦βcat_Set Ξ²β E'β¦ObjMapβ¦β¦aβ¦"
if "a ββ©β op_cat πβ¦Objβ¦" for a
by (intro cat_Set_is_arr_isomorphismD[OF Y'_NTMap_a[OF that]])
show
"Y'β¦NTMapβ¦β¦bβ¦ ββ©Aβcat_Set Ξ²β N'β¦ArrMapβ¦β¦fβ¦ =
E'β¦ArrMapβ¦β¦fβ¦ ββ©Aβcat_Set Ξ²β Y'β¦NTMapβ¦β¦aβ¦"
if "f : a β¦βop_cat πβ b" for a b f
proof-
note f = that[unfolded cat_op_simps]
from f assms(3) show ?thesis
by
(
cs_concl
cs_simp: cat_cs_simps Y.ntcf_Comp_commute
cs_intro: cat_cs_intros cat_prod_cs_intros cat_FUNCT_cs_intros
)+
qed
qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
have E'_def: "E' = Homβ©Oβ©.β©CβΞ²βπ(-,?πc)"
proof(rule cf_eqI)
show "E' : op_cat π β¦β¦β©CβΞ²β cat_Set Ξ²"
by (cs_concl cs_intro: cat_cs_intros)
from assms(3) show
"Homβ©Oβ©.β©CβΞ²βπ(-,?πc) : op_cat π β¦β¦β©CβΞ²β cat_Set Ξ²"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
have dom_lhs: "πβ©β (E'β¦ObjMapβ¦) = πβ¦Objβ¦" unfolding E'_components by simp
from assms(3) have dom_rhs:
"πβ©β (Homβ©Oβ©.β©CβΞ²βπ(-,?πc)β¦ObjMapβ¦) = πβ¦Objβ¦"
unfolding E'_components
by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
show "E'β¦ObjMapβ¦ = Homβ©Oβ©.β©CβΞ²βπ(-,?πc)β¦ObjMapβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix a assume "a ββ©β πβ¦Objβ¦"
with assms(3) show "E'β¦ObjMapβ¦β¦aβ¦ = Homβ©Oβ©.β©CβΞ²βπ(-,?πc)β¦ObjMapβ¦β¦aβ¦"
by
(
cs_concl
cs_simp: cat_op_simps cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros
)
qed (auto simp: E'_components cat_cs_intros assms(3))
have dom_lhs: "πβ©β (E'β¦ArrMapβ¦) = πβ¦Arrβ¦" unfolding E'_components by simp
from assms(3) have dom_rhs:
"πβ©β (Homβ©Oβ©.β©CβΞ²βπ(-,?πc)β¦ArrMapβ¦) = πβ¦Arrβ¦"
unfolding E'_components
by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
show "E'β¦ArrMapβ¦ = Homβ©Oβ©.β©CβΞ²βπ(-,?πc)β¦ArrMapβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix f assume prems: "f ββ©β πβ¦Arrβ¦"
then obtain a b where f: "f : a β¦βπβ b" by auto
have [cat_cs_simps]:
"cf_eval_arrow β (ntcf_arrow (?H_Aπ f)) (ββ¦CIdβ¦β¦cβ¦) =
cf_hom π [f, πβ¦CIdβ¦β¦?πcβ¦]β©β"
(is βΉ?cf_eval_arrow = ?cf_hom_fπcβΊ)
proof-
have cf_eval_arrow_f_CId_πc:
"?cf_eval_arrow :
Hom π b ?πc β¦βcat_Set Ξ±β Hom π a ?πc"
proof(rule cf_eval_arrow_is_arr')
from f show "?H_Aπ f :
?H_ππ b β¦β©Cβ©F ?H_ππ a : β β¦β¦β©CβΞ±β cat_Set Ξ±"
by (cs_concl cs_intro: cat_cs_intros)
qed
(
use f assms(3) in
βΉ
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
βΊ
)+
from f assms(3) have dom_lhs:
"πβ©β (?cf_eval_arrowβ¦ArrValβ¦) = Hom π b ?πc"
by
(
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
)
from assms(3) f Ran.HomCod.category_axioms have cf_hom_fπc:
"?cf_hom_fπc :
Hom π b ?πc β¦βcat_Set Ξ±β Hom π a ?πc"
by
(
cs_concl cs_intro:
cat_cs_intros cat_prod_cs_intros cat_op_intros
)
from f assms(3) have dom_rhs:
"πβ©β (?cf_hom_fπcβ¦ArrValβ¦) = Hom π b ?πc"
by
(
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
)
show ?thesis
proof(rule arr_Set_eqI)
from cf_eval_arrow_f_CId_πc show "arr_Set Ξ± ?cf_eval_arrow"
by (auto dest: cat_Set_is_arrD(1))
from cf_hom_fπc show "arr_Set Ξ± ?cf_hom_fπc"
by (auto dest: cat_Set_is_arrD(1))
show "?cf_eval_arrowβ¦ArrValβ¦ = ?cf_hom_fπcβ¦ArrValβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs, unfold in_Hom_iff)
from f assms(3) show "vsv (?cf_eval_arrowβ¦ArrValβ¦)"
by (cs_concl cs_intro: cat_cs_intros)
from f assms(3) show "vsv (?cf_hom_fπcβ¦ArrValβ¦)"
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros
)
fix g assume "g : b β¦βπβ ?πc"
with f assms(3) show
"?cf_eval_arrowβ¦ArrValβ¦β¦gβ¦ = ?cf_hom_fπcβ¦ArrValβ¦β¦gβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros
)
qed simp
qed
(
use cf_eval_arrow_f_CId_πc cf_hom_fπc in
βΉcs_concl cs_simp: cat_cs_simpsβΊ
)+
qed
from f prems assms(3) show
"E'β¦ArrMapβ¦β¦fβ¦ = Homβ©Oβ©.β©CβΞ²βπ(-,?πc)β¦ArrMapβ¦β¦fβ¦"
by
(
cs_concl
cs_simp: cat_op_simps cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros
)
qed (auto simp: E'_components cat_cs_intros assms(3))
qed simp_all
from Y' have inv_Y': "inv_ntcf Y' :
Homβ©Oβ©.β©CβΞ²βπ(-,?πc) β¦β©Cβ©Fβ©.β©iβ©sβ©o N' : op_cat π β¦β¦β©CβΞ²β cat_Set Ξ²"
unfolding E'_def by (auto intro: iso_ntcf_is_arr_isomorphism)
interpret N'': is_functor Ξ² βΉop_cat πβΊ βΉcat_Set Ξ²βΊ βΉL_10_5_N Ξ± Ξ² π π cβΊ
by (rule L_10_5_N_is_functor[OF Ξ² Ξ±Ξ² assms])
define Ο :: V
where "Ο =
[
(Ξ»aββ©βπβ¦Objβ¦. ?ntcf_ua_fo aβ¦NTMapβ¦β¦cf_map (?H_β c)β¦),
N',
L_10_5_N Ξ± Ξ² π π c,
op_cat π,
cat_Set Ξ²
]β©β"
have Ο_components:
"Οβ¦NTMapβ¦ = (Ξ»aββ©βπβ¦Objβ¦. ?ntcf_ua_fo aβ¦NTMapβ¦β¦cf_map (?H_β c)β¦)"
"Οβ¦NTDomβ¦ = N'"
"Οβ¦NTCodβ¦ = L_10_5_N Ξ± Ξ² π π c"
"Οβ¦NTDGDomβ¦ = op_cat π"
"Οβ¦NTDGCodβ¦ = cat_Set Ξ²"
unfolding Ο_def nt_field_simps by (simp_all add: nat_omega_simps)
note [cat_cs_simps] = Y'_components(2-5)
have Ο_NTMap_app[cat_cs_simps]:
"Οβ¦NTMapβ¦β¦aβ¦ = ?ntcf_ua_fo aβ¦NTMapβ¦β¦cf_map (?H_β c)β¦"
if "a ββ©β πβ¦Objβ¦" for a
using that unfolding Ο_components by simp
have Ο: "Ο : N' β¦β©Cβ©Fβ©.β©iβ©sβ©o L_10_5_N Ξ± Ξ² π π c : op_cat π β¦β¦β©CβΞ²β cat_Set Ξ²"
proof-
show ?thesis
proof(intro is_iso_ntcfI is_ntcfI')
show "vfsequence Ο" unfolding Ο_def by auto
show "vcard Ο = 5β©β" unfolding Ο_def by (simp_all add: nat_omega_simps)
show "N' : op_cat π β¦β¦β©CβΞ²β cat_Set Ξ²" by (rule N')
show "L_10_5_N Ξ± Ξ² π π c : op_cat π β¦β¦β©CβΞ²β cat_Set Ξ²"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "Οβ¦NTDomβ¦ = N'" unfolding Ο_components by simp
show "Οβ¦NTCodβ¦ = L_10_5_N Ξ± Ξ² π π c" unfolding Ο_components by simp
show "Οβ¦NTDGDomβ¦ = op_cat π" unfolding Ο_components by simp
show "Οβ¦NTDGCodβ¦ = cat_Set Ξ²" unfolding Ο_components by simp
show "vsv (Οβ¦NTMapβ¦)" unfolding Ο_components by simp
show "πβ©β (Οβ¦NTMapβ¦) = op_cat πβ¦Objβ¦"
unfolding Ο_components by (simp add: cat_op_simps)
show Ο_NTMap_is_arr_isomorphism[unfolded cat_op_simps]:
"Οβ¦NTMapβ¦β¦aβ¦ : N'β¦ObjMapβ¦β¦aβ¦ β¦β©iβ©sβ©oβcat_Set Ξ²β L_10_5_N Ξ± Ξ² π π cβ¦ObjMapβ¦β¦aβ¦"
if "a ββ©β op_cat πβ¦Objβ¦" for a
proof-
note a = that[unfolded cat_op_simps]
interpret Ξ΅:
is_cat_rKe_preserves Ξ± π
β π βΉcat_Set Ξ±βΊ π π π βΉ?H_π aβΊ Ξ΅
by (rule cat_pw_rKe_preserved[OF a])
interpret aΞ΅:
is_cat_rKe Ξ± π
β βΉcat_Set Ξ±βΊ π βΉ?H_ππ aβΊ βΉ?H_ππ aβΊ βΉ?H_πΞ΅ aβΊ
by (rule Ξ΅.cat_rKe_preserves)
interpret is_iso_ntcf
Ξ²
βΉop_cat (?FUNCT β)βΊ
βΉcat_Set Ξ²βΊ
βΉ?H_FUNCT β (?H_ππ a)βΊ
βΉ?H_FUNCT π
(?H_ππ a) ββ©Cβ©F op_cf ?SET_πβΊ
βΉ?ntcf_ua_fo aβΊ
by (rule aΞ΅.cat_rKe_ntcf_ua_fo_is_iso_ntcf_if_ge_Limit[OF Ξ² Ξ±Ξ²])
have "cf_map (?H_β c) ββ©β ?FUNCT ββ¦Objβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
from
iso_ntcf_is_arr_isomorphism[unfolded cat_op_simps, OF this]
a assms Ξ±Ξ²
show ?thesis
by
(
cs_prems
cs_simp:
cat_cs_simps cat_Kan_cs_simps cat_FUNCT_cs_simps cat_op_simps
cs_intro:
cat_small_cs_intros
cat_Kan_cs_intros
cat_cs_intros
cat_FUNCT_cs_intros
cat_op_intros
)
qed
show Ο_NTMap_is_arr[unfolded cat_op_simps]:
"Οβ¦NTMapβ¦β¦aβ¦ : N'β¦ObjMapβ¦β¦aβ¦ β¦βcat_Set Ξ²β L_10_5_N Ξ± Ξ² π π cβ¦ObjMapβ¦β¦aβ¦"
if "a ββ©β op_cat πβ¦Objβ¦" for a
by
(
rule cat_Set_is_arr_isomorphismD[
OF Ο_NTMap_is_arr_isomorphism[OF that[unfolded cat_op_simps]]
]
)
show
"Οβ¦NTMapβ¦β¦bβ¦ ββ©Aβcat_Set Ξ²β N'β¦ArrMapβ¦β¦fβ¦ =
L_10_5_N Ξ± Ξ² π π cβ¦ArrMapβ¦β¦fβ¦ ββ©Aβcat_Set Ξ²β Οβ¦NTMapβ¦β¦aβ¦"
if "f : a β¦βop_cat πβ b" for a b f
proof-
note f = that[unfolded cat_op_simps]
from f have a: "a ββ©β πβ¦Objβ¦" and b: "b ββ©β πβ¦Objβ¦" by auto
interpret p_a_Ξ΅:
is_cat_rKe_preserves Ξ± π
β π βΉcat_Set Ξ±βΊ π π π βΉ?H_π aβΊ Ξ΅
by (rule cat_pw_rKe_preserved[OF a])
interpret a_Ξ΅: is_cat_rKe
Ξ± π
β βΉcat_Set Ξ±βΊ π βΉ?H_ππ aβΊ βΉ?H_ππ aβΊ βΉ?H_πΞ΅ aβΊ
by (rule p_a_Ξ΅.cat_rKe_preserves)
interpret ntcf_ua_fo_a_Ξ΅: is_iso_ntcf
Ξ² ?ua_NTDGDom βΉcat_Set Ξ²βΊ βΉ?ua_NTDom aβΊ βΉ?ua_NTCod aβΊ βΉ?ua aβΊ
by (rule a_Ξ΅.cat_rKe_ntcf_ua_fo_is_iso_ntcf_if_ge_Limit[OF Ξ² Ξ±Ξ²])
interpret p_b_Ξ΅:
is_cat_rKe_preserves Ξ± π
β π βΉcat_Set Ξ±βΊ π π π βΉ?H_π bβΊ Ξ΅
by (rule cat_pw_rKe_preserved[OF b])
interpret b_Ξ΅: is_cat_rKe
Ξ± π
β βΉcat_Set Ξ±βΊ π βΉ?H_ππ bβΊ βΉ?H_ππ bβΊ βΉ?H_πΞ΅ bβΊ
by (rule p_b_Ξ΅.cat_rKe_preserves)
interpret ntcf_ua_fo_b_Ξ΅: is_iso_ntcf
Ξ² ?ua_NTDGDom βΉcat_Set Ξ²βΊ βΉ?ua_NTDom bβΊ βΉ?ua_NTCod bβΊ βΉ?ua bβΊ
by (rule b_Ξ΅.cat_rKe_ntcf_ua_fo_is_iso_ntcf_if_ge_Limit[OF Ξ² Ξ±Ξ²])
interpret π_SET: is_tiny_functor Ξ² βΉ?FUNCT ββΊ βΉ?FUNCT π
βΊ ?SET_π
by
(
rule exp_cat_cf_is_tiny_functor[
OF Ξ² Ξ±Ξ² AG.category_cat_Set AG.is_functor_axioms
]
)
from f interpret Hom_f:
is_ntcf Ξ± π βΉcat_Set Ξ±βΊ βΉ?H_π aβΊ βΉ?H_π bβΊ βΉ?H_A fβΊ
by (cs_concl cs_intro: cat_cs_intros)
let ?cf_hom_lhs =
βΉ
cf_hom
(?FUNCT β)
[ntcf_arrow (ntcf_id (?H_β c)), ntcf_arrow (?H_Aπ f)]β©β
βΊ
let ?cf_hom_rhs =
βΉ
cf_hom
(?FUNCT π
)
[
ntcf_arrow (ntcf_id (?H_β c ββ©Cβ©F π)),
ntcf_arrow (?H_A f ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π)
]β©β
βΊ
let ?dom =
βΉHom (?FUNCT β) (cf_map (?H_β c)) (cf_map (?H_ππ a))βΊ
let ?cod = βΉHom (?FUNCT π
) (cf_map (?H_βπ c)) (cf_map (?H_ππ b))βΊ
let ?cf_hom_lhs_umap_fo_inter =
βΉHom (?FUNCT β) (cf_map (?H_β c)) (cf_map (?H_ππ b))βΊ
let ?umap_fo_cf_hom_rhs_inter =
βΉHom (?FUNCT π
) (cf_map (?H_βπ c)) (cf_map (?H_ππ a))βΊ
have [cat_cs_simps]:
"?umap_fo b ββ©Aβcat_Set Ξ²β ?cf_hom_lhs =
?cf_hom_rhs ββ©Aβcat_Set Ξ²β ?umap_fo a"
proof-
from f assms(3) Ξ±Ξ² have cf_hom_lhs:
"?cf_hom_lhs : ?dom β¦βcat_Set Ξ²β ?cf_hom_lhs_umap_fo_inter"
by
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps
cs_intro:
cat_cs_intros
cat_FUNCT_cs_intros
cat_prod_cs_intros
cat_op_intros
)
from f assms(3) Ξ±Ξ² have umap_fo_b:
"?umap_fo b : ?cf_hom_lhs_umap_fo_inter β¦βcat_Set Ξ²β ?cod"
by
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps
cs_intro:
cat_small_cs_intros
cat_cs_intros
cat_FUNCT_cs_intros
cat_prod_cs_intros
cat_op_intros
)
from cf_hom_lhs umap_fo_b have umap_fo_cf_hom_lhs:
"?umap_fo b ββ©Aβcat_Set Ξ²β ?cf_hom_lhs : ?dom β¦βcat_Set Ξ²β ?cod"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
then have dom_umap_fo_cf_hom_lhs:
"πβ©β ((?umap_fo b ββ©Aβcat_Set Ξ²β ?cf_hom_lhs)β¦ArrValβ¦) = ?dom"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from f assms(3) Ξ±Ξ² have cf_hom_rhs:
"?cf_hom_rhs : ?umap_fo_cf_hom_rhs_inter β¦βcat_Set Ξ²β ?cod"
by
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps
cs_intro:
cat_cs_intros
cat_FUNCT_cs_intros
cat_prod_cs_intros
cat_op_intros
)
from f assms(3) Ξ±Ξ² have umap_fo_a:
"?umap_fo a : ?dom β¦βcat_Set Ξ²β ?umap_fo_cf_hom_rhs_inter"
by
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps
cs_intro:
cat_small_cs_intros
cat_cs_intros
cat_FUNCT_cs_intros
cat_prod_cs_intros
cat_op_intros
)
from cf_hom_rhs umap_fo_a have cf_hom_rhs_umap_fo_a:
"?cf_hom_rhs ββ©Aβcat_Set Ξ²β ?umap_fo a : ?dom β¦βcat_Set Ξ²β ?cod"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros )
then have dom_cf_hom_rhs_umap_fo_a:
"πβ©β ((?cf_hom_rhs ββ©Aβcat_Set Ξ²β ?umap_fo a)β¦ArrValβ¦) = ?dom"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show ?thesis
proof(rule arr_Set_eqI)
from umap_fo_cf_hom_lhs show arr_Set_umap_fo_cf_hom_lhs:
"arr_Set Ξ² (?umap_fo b ββ©Aβcat_Set Ξ²β ?cf_hom_lhs)"
by (auto dest: cat_Set_is_arrD(1))
from cf_hom_rhs_umap_fo_a show arr_Set_cf_hom_rhs_umap_fo_a:
"arr_Set Ξ² (?cf_hom_rhs ββ©Aβcat_Set Ξ²β ?umap_fo a)"
by (auto dest: cat_Set_is_arrD(1))
show
"(?umap_fo b ββ©Aβcat_Set Ξ²β ?cf_hom_lhs)β¦ArrValβ¦ =
(?cf_hom_rhs ββ©Aβcat_Set Ξ²β ?umap_fo a)β¦ArrValβ¦"
proof
(
rule vsv_eqI,
unfold
dom_umap_fo_cf_hom_lhs dom_cf_hom_rhs_umap_fo_a in_Hom_iff;
(rule refl)?
)
fix β assume prems:
"β : cf_map (?H_β c) β¦β?FUNCT ββ cf_map (?H_ππ a)"
let ?β = βΉntcf_of_ntcf_arrow β (cat_Set Ξ±) ββΊ
let ?lhs = βΉ?H_πΞ΅ b ββ©Nβ©Tβ©Cβ©F ((?H_Aπ f ββ©Nβ©Tβ©Cβ©F ?β) ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π)βΊ
let ?rhs =
βΉ(?H_A f ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π ββ©Nβ©Tβ©Cβ©F ?H_πΞ΅ a ββ©Nβ©Tβ©Cβ©F (?β ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π))βΊ
let ?cf_hom_πΞ΅ = βΉΞ»b b'. cf_hom π [πβ¦CIdβ¦β¦bβ¦, Ξ΅β¦NTMapβ¦β¦b'β¦]β©ββΊ
let ?Yc = βΉΞ»Q. Yoneda_component (?H_π b) a f QβΊ
let ?βπ = βΉΞ»b'. ?ββ¦NTMapβ¦β¦πβ¦ObjMapβ¦β¦b'β¦β¦βΊ
let ?ππ = βΉΞ»b'. πβ¦ObjMapβ¦β¦πβ¦ObjMapβ¦β¦b'β¦β¦βΊ
have [cat_cs_simps]:
"cf_of_cf_map β (cat_Set Ξ±) (cf_map (?H_β c)) = ?H_β c"
by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
have [cat_cs_simps]:
"cf_of_cf_map β (cat_Set Ξ±) (cf_map (?H_ππ a)) = ?H_ππ a"
by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
note β = cat_FUNCT_is_arrD[OF prems, unfolded cat_cs_simps]
have Hom_c: "?H_βπ c : π
β¦β¦β©CβΞ±β cat_Set Ξ±"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
have [cat_cs_simps]: "?lhs = ?rhs"
proof(rule ntcf_eqI)
from β(1) f show lhs:
"?lhs : ?H_βπ c β¦β©Cβ©F ?H_ππ b : π
β¦β¦β©CβΞ±β cat_Set Ξ±"
by (cs_concl cs_simp: cs_intro: cat_cs_intros)
then have dom_lhs: "πβ©β (?lhsβ¦NTMapβ¦) = π
β¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps)+
from β(1) f show rhs:
"?rhs : ?H_βπ c β¦β©Cβ©F ?H_ππ b : π
β¦β¦β©CβΞ±β cat_Set Ξ±"
by (cs_concl cs_simp: cs_intro: cat_cs_intros)
then have dom_rhs: "πβ©β (?rhsβ¦NTMapβ¦) = π
β¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps)+
have [cat_cs_simps]:
"?cf_hom_πΞ΅ b b' ββ©Aβcat_Set Ξ±β
(?Yc (?ππ b') ββ©Aβcat_Set Ξ±β ?βπ b') =
?Yc (πβ¦ObjMapβ¦β¦b'β¦) ββ©Aβcat_Set Ξ±β
(?cf_hom_πΞ΅ a b' ββ©Aβcat_Set Ξ±β ?βπ b')"
(is βΉ?lhs_Set = ?rhs_SetβΊ)
if "b' ββ©β π
β¦Objβ¦" for b'
proof-
let ?πb' = βΉπβ¦ObjMapβ¦β¦b'β¦βΊ
from β(1) f that assms(3) Ran.HomCod.category_axioms
have lhs_Set_is_arr: "?lhs_Set :
Hom β c (?πb') β¦βcat_Set Ξ±β Hom π b (πβ¦ObjMapβ¦β¦b'β¦)"
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro:
cat_cs_intros cat_prod_cs_intros cat_op_intros
)
then have dom_lhs_Set: "πβ©β (?lhs_Setβ¦ArrValβ¦) = Hom β c ?πb'"
by (cs_concl cs_simp: cat_cs_simps)
from β(1) f that assms(3) Ran.HomCod.category_axioms
have rhs_Set_is_arr: "?rhs_Set :
Hom β c (?πb') β¦βcat_Set Ξ±β Hom π b (πβ¦ObjMapβ¦β¦b'β¦)"
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro:
cat_cs_intros cat_prod_cs_intros cat_op_intros
)
then have dom_rhs_Set: "πβ©β (?rhs_Setβ¦ArrValβ¦) = Hom β c ?πb'"
by (cs_concl cs_simp: cat_cs_simps)
show ?thesis
proof(rule arr_Set_eqI)
from lhs_Set_is_arr show arr_Set_lhs_Set: "arr_Set Ξ± ?lhs_Set"
by (auto dest: cat_Set_is_arrD(1))
from rhs_Set_is_arr show arr_Set_rhs_Set: "arr_Set Ξ± ?rhs_Set"
by (auto dest: cat_Set_is_arrD(1))
show "?lhs_Setβ¦ArrValβ¦ = ?rhs_Setβ¦ArrValβ¦"
proof(rule vsv_eqI, unfold dom_lhs_Set dom_rhs_Set in_Hom_iff)
fix h assume "h : c β¦βββ ?πb'"
with β(1) f that assms Ran.HomCod.category_axioms show
"?lhs_Setβ¦ArrValβ¦β¦hβ¦ = ?rhs_Setβ¦ArrValβ¦β¦hβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro:
cat_cs_intros cat_prod_cs_intros cat_op_intros
)
qed (use arr_Set_lhs_Set arr_Set_rhs_Set in auto)
qed
(
use lhs_Set_is_arr rhs_Set_is_arr in
βΉcs_concl cs_simp: cat_cs_simpsβΊ
)+
qed
show "?lhsβ¦NTMapβ¦ = ?rhsβ¦NTMapβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix b' assume "b' ββ©β π
β¦Objβ¦"
with β(1) f assms(3) show "?lhsβ¦NTMapβ¦β¦b'β¦ = ?rhsβ¦NTMapβ¦β¦b'β¦"
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros
)
qed (cs_concl cs_intro: cat_cs_intros)
qed simp_all
from
assms(3) f β(1) prems Ξ±Ξ²
Ran.HomCod.category_axioms
FUNCT_β.category_axioms
FUNCT_π
.category_axioms
AG.is_functor_axioms
Ran.is_functor_axioms
Hom_f.is_ntcf_axioms
show
"(?umap_fo b ββ©Aβcat_Set Ξ²β ?cf_hom_lhs)β¦ArrValβ¦β¦ββ¦ =
(?cf_hom_rhs ββ©Aβcat_Set Ξ²β ?umap_fo a)β¦ArrValβ¦β¦ββ¦"
by (subst (1 2) β(2))
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps cat_op_simps
cs_intro:
cat_cs_intros
cat_prod_cs_intros
cat_FUNCT_cs_intros
cat_op_intros
)
qed
(
use arr_Set_umap_fo_cf_hom_lhs arr_Set_cf_hom_rhs_umap_fo_a in
auto
)
qed
(
use umap_fo_cf_hom_lhs cf_hom_rhs_umap_fo_a in
βΉcs_concl cs_simp: cat_cs_simpsβΊ
)+
qed
from f assms Ξ±Ξ² show ?thesis
by
(
cs_concl
cs_simp: cat_cs_simps cat_Kan_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
qed
qed auto
qed
from L_10_5_Ο_is_iso_ntcf[OF Ξ² Ξ±Ξ² assms] have inv_Ο:
"inv_ntcf (L_10_5_Ο Ξ± Ξ² π π c) :
L_10_5_N Ξ± Ξ² π π c β¦β©Cβ©Fβ©.β©iβ©sβ©o cf_Cone Ξ± Ξ² ?π_cπ :
op_cat π β¦β¦β©CβΞ²β cat_Set Ξ²"
by (auto intro: iso_ntcf_is_arr_isomorphism)
define Ο where "Ο = inv_ntcf (L_10_5_Ο Ξ± Ξ² π π c) ββ©Nβ©Tβ©Cβ©F Ο ββ©Nβ©Tβ©Cβ©F inv_ntcf Y'"
from inv_Y' Ο inv_Ο have Ο: "Ο :
Homβ©Oβ©.β©CβΞ²βπ(-,?πc) β¦β©Cβ©Fβ©.β©iβ©sβ©o cf_Cone Ξ± Ξ² ?π_cπ :
op_cat π β¦β¦β©CβΞ²β cat_Set Ξ²"
unfolding Ο_def by (cs_concl cs_intro: cat_cs_intros)
interpret Ο: is_iso_ntcf
Ξ² βΉop_cat πβΊ βΉcat_Set Ξ²βΊ βΉHomβ©Oβ©.β©CβΞ²βπ(-,?πc)βΊ βΉcf_Cone Ξ± Ξ² ?π_cπβΊ Ο
by (rule Ο)
let ?Ο_πc_CId = βΉΟβ¦NTMapβ¦β¦?πcβ¦β¦ArrValβ¦β¦πβ¦CIdβ¦β¦?πcβ¦β¦βΊ
let ?ntcf_Ο_πc_CId = βΉntcf_of_ntcf_arrow (c ββ©Cβ©F π) π ?Ο_πc_CIdβΊ
from AG.vempty_is_zet assms(3) have Ξ: "?Ξ : π β¦β¦β©CβΞ±β ?cπ_π"
by
(
cs_concl
cs_simp: cat_comma_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_comma_cs_intros
)
from assms(3) have πc: "?πc ββ©β πβ¦Objβ¦"
by (cs_concl cs_intro: cat_cs_intros)
from AG.vempty_is_zet have π_cπ: "cf_map (?π_cπ) ββ©β ?cπ_πβ¦Objβ¦"
by
(
cs_concl
cs_simp: cat_Funct_components(1)
cs_intro: cat_small_cs_intros cat_FUNCT_cs_intros
)
from
Ο.ntcf_NTMap_is_arr[unfolded cat_op_simps, OF πc]
assms(3)
AG.vempty_is_zet
Ξ².vempty_is_zet
Ξ±Ξ²
have Ο_πc: "Οβ¦NTMapβ¦β¦?πcβ¦ :
Hom π ?πc?πc β¦βcat_Set Ξ²β
Hom ?cπ_π (cf_map (?cf_cπ_π ?πc)) (cf_map ?π_cπ)"
by
(
cs_prems
cs_simp:
cat_cs_simps
cat_Kan_cs_simps
cat_comma_cs_simps
cat_op_simps
cat_Funct_components(1)
cs_intro:
cat_small_cs_intros
cat_Kan_cs_intros
cat_comma_cs_intros
cat_cs_intros
cat_FUNCT_cs_intros
cat_op_intros
category.cat_category_if_ge_Limit[where Ξ±=Ξ± and Ξ²=Ξ²]
is_functor.cf_is_functor_if_ge_Limit[where Ξ±=Ξ± and Ξ²=Ξ²]
)
with assms(3) have Ο_πc_CId:
"?Ο_πc_CId : cf_map (?cf_cπ_π ?πc) β¦β?cπ_πβ cf_map ?π_cπ"
by (cs_concl cs_intro: cat_cs_intros)
have ntcf_arrow_Ο_πc_CId: "ntcf_arrow ?ntcf_Ο_πc_CId = ?Ο_πc_CId"
by (rule cat_Funct_is_arrD(2)[OF Ο_πc_CId, symmetric])
have ua: "universal_arrow_fo ?Ξ (cf_map (?π_cπ)) ?πc ?Ο_πc_CId"
by
(
rule is_functor.cf_universal_arrow_fo_if_is_iso_ntcf_if_ge_Limit[
OF Ξ Ξ² Ξ±Ξ² πc π_cπ Ο[unfolded cf_Cone_def cat_cs_simps]
]
)
moreover have ntcf_Ο_πc_CId:
"?ntcf_Ο_πc_CId : ?πc <β©Cβ©Fβ©.β©cβ©oβ©nβ©e ?π_cπ : c ββ©Cβ©F π β¦β¦β©CβΞ±β π"
proof(intro is_cat_coneI)
from cat_Funct_is_arrD(1)[OF Ο_πc_CId] assms(3) AG.vempty_is_zet show
"ntcf_of_ntcf_arrow (c ββ©Cβ©F π) π ?Ο_πc_CId :
?cf_cπ_π ?πc β¦β©Cβ©Fβ©.β©tβ©m ?π_cπ : c ββ©Cβ©F π β¦β¦β©Cβ©.β©tβ©mβΞ±β π"
by
(
cs_prems
cs_simp: cat_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
qed (rule πc)
ultimately have "?ntcf_Ο_πc_CId : ?πc <β©Cβ©Fβ©.β©lβ©iβ©m ?π_cπ : c ββ©Cβ©F π β¦β¦β©CβΞ±β π"
by
(
intro is_cat_limitI[
where u=βΉ?ntcf_Ο_πc_CIdβΊ, unfolded ntcf_arrow_Ο_πc_CId
]
)
then show ?thesis using that by auto
qed
subsectionβΉThe limit for the pointwise Kan extensionβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉSee Theorem 3 in Chapter X-5 in \cite{mac_lane_categories_2010}.βΊ
definition the_pw_cat_rKe_limit :: "V β V β V β V β V β V"
where "the_pw_cat_rKe_limit Ξ± π π π c =
[
πβ¦ObjMapβ¦β¦cβ¦,
(
SOME UA.
UA : πβ¦ObjMapβ¦β¦cβ¦ <β©Cβ©Fβ©.β©lβ©iβ©m π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π : c ββ©Cβ©F π β¦β¦β©CβΞ±β πβ¦HomCodβ¦
)
]β©β"
textβΉComponents.βΊ
lemma the_pw_cat_rKe_limit_components:
shows "the_pw_cat_rKe_limit Ξ± π π π cβ¦UObjβ¦ = πβ¦ObjMapβ¦β¦cβ¦"
and "the_pw_cat_rKe_limit Ξ± π π π cβ¦UArrβ¦ =
(
SOME UA.
UA : πβ¦ObjMapβ¦β¦cβ¦ <β©Cβ©Fβ©.β©lβ©iβ©m π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π : c ββ©Cβ©F π β¦β¦β©CβΞ±β πβ¦HomCodβ¦
)"
unfolding the_pw_cat_rKe_limit_def ua_field_simps
by (simp_all add: nat_omega_simps)
context is_functor
begin
lemmas the_pw_cat_rKe_limit_components' =
the_pw_cat_rKe_limit_components[where π=π, unfolded cat_cs_simps]
end
subsubsectionβΉThe limit for the pointwise Kan extension is a limitβΊ
lemma (in is_cat_pw_rKe) cat_pw_rKe_the_pw_cat_rKe_limit_is_limit:
assumes "π : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
and "π : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β π"
and "c ββ©β ββ¦Objβ¦"
shows "the_pw_cat_rKe_limit Ξ± π π π cβ¦UArrβ¦ :
the_pw_cat_rKe_limit Ξ± π π π cβ¦UObjβ¦ <β©Cβ©Fβ©.β©lβ©iβ©m π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π :
c ββ©Cβ©F π β¦β¦β©CβΞ±β π"
proof-
from cat_pw_rKe_ex_cat_limit[OF assms] obtain UA
where UA: "UA : πβ¦ObjMapβ¦β¦cβ¦ <β©Cβ©Fβ©.β©lβ©iβ©m π ββ©Cβ©F c β©Oβ¨
β©Cβ©F π : c ββ©Cβ©F π β¦β¦β©CβΞ±β π"
by auto
show ?thesis
unfolding the_pw_cat_rKe_limit_components
by (rule someI2, unfold cat_cs_simps, rule UA)
qed
lemma (in is_cat_pw_rKe) cat_pw_rKe_the_ntcf_rKe_is_cat_rKe:
assumes "π : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
and "π : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β π"
shows "the_ntcf_rKe Ξ± π π (the_pw_cat_rKe_limit Ξ± π π π) :
the_cf_rKe Ξ± π π (the_pw_cat_rKe_limit Ξ± π π π) ββ©Cβ©F π β¦β©Cβ©Fβ©.β©rβ©Kβ©eβΞ±β π :
π
β¦β©C β β¦β©C π"
proof-
interpret π: is_tm_functor Ξ± π
π π by (rule assms(2))
show "the_ntcf_rKe Ξ± π π (the_pw_cat_rKe_limit Ξ± π π π) :
the_cf_rKe Ξ± π π (the_pw_cat_rKe_limit Ξ± π π π) ββ©Cβ©F π β¦β©Cβ©Fβ©.β©rβ©Kβ©eβΞ±β π :
π
β¦β©C β β¦β©C π"
by
(
rule
the_ntcf_rKe_is_cat_rKe
[
OF
assms(1)
ntcf_rKe.NTCod.is_functor_axioms
cat_pw_rKe_the_pw_cat_rKe_limit_is_limit[OF assms]
]
)
qed
textβΉ\newpageβΊ
endTheory CZH_UCAT_PWKan_Example
sectionβΉPointwise Kan extensions: application exampleβΊ
theory CZH_UCAT_PWKan_Example
imports
CZH_Elementary_Categories.CZH_ECAT_Ordinal
CZH_UCAT_PWKan
begin
subsectionβΉBackgroundβΊ
textβΉ
The application example presented in this section is based on
Exercise 6.1.ii in \cite{riehl_category_2016}.
βΊ
lemma cat_ordinal_2_is_arrE:
assumes "f : a β¦βcat_ordinal (2β©β)β b"
obtains "f = [0, 0]β©β" and " a = 0" and "b = 0"
| "f = [0, 1β©β]β©β" and "a = 0" and "b = 1β©β"
| "f = [1β©β, 1β©β]β©β" and "a = 1β©β" and "b = 1β©β"
using cat_ordinal_is_arrD[OF assms] unfolding two by auto
lemma cat_ordinal_3_is_arrE:
assumes "f : a β¦βcat_ordinal (3β©β)β b"
obtains "f = [0, 0]β©β" and " a = 0" and "b = 0"
| "f = [0, 1β©β]β©β" and "a = 0" and "b = 1β©β"
| "f = [0, 2β©β]β©β" and "a = 0" and "b = 2β©β"
| "f = [1β©β, 1β©β]β©β" and "a = 1β©β" and "b = 1β©β"
| "f = [1β©β, 2β©β]β©β" and "a = 1β©β" and "b = 2β©β"
| "f = [2β©β, 2β©β]β©β" and "a = 2β©β" and "b = 2β©β"
using cat_ordinal_is_arrD[OF assms] unfolding three by auto
lemma 0123: "0 ββ©β 2β©β" "1β©β ββ©β 2β©β" "0 ββ©β 3β©β" "1β©β ββ©β 3β©β" "2β©β ββ©β 3β©β" by auto
subsectionβΉβΉπ23βΊβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition π23 :: V
where "π23 =
[
(Ξ»aββ©βcat_ordinal (2β©β)β¦Objβ¦. if a = 0 then 0 else 2β©β),
(
Ξ»fββ©βcat_ordinal (2β©β)β¦Arrβ¦.
if f = [0, 0]β©β β [0, 0]β©β
| f = [0, 1β©β]β©β β [0, 2β©β]β©β
| f = [1β©β, 1β©β]β©β β [2β©β, 2β©β]β©β
| otherwise β 0
),
cat_ordinal (2β©β),
cat_ordinal (3β©β)
]β©β"
textβΉComponents.βΊ
lemma π23_components:
shows "π23β¦ObjMapβ¦ = (Ξ»aββ©βcat_ordinal (2β©β)β¦Objβ¦. if a = 0 then 0 else 2β©β)"
and "π23β¦ArrMapβ¦ =
(
Ξ»fββ©βcat_ordinal (2β©β)β¦Arrβ¦.
if f = [0, 0]β©β β [0, 0]β©β
| f = [0, 1β©β]β©β β [0, 2β©β]β©β
| f = [1β©β, 1β©β]β©β β [2β©β, 2β©β]β©β
| otherwise β 0
)"
and [cat_Kan_cs_simps]: "π23β¦HomDomβ¦ = cat_ordinal (2β©β)"
and [cat_Kan_cs_simps]: "π23β¦HomCodβ¦ = cat_ordinal (3β©β)"
unfolding π23_def dghm_field_simps by (simp_all add: nat_omega_simps)
subsubsectionβΉObject mapβΊ
mk_VLambda π23_components(1)
|vsv π23_ObjMap_vsv[cat_Kan_cs_intros]|
|vdomain π23_ObjMap_vdomain[cat_Kan_cs_simps]|
|app π23_ObjMap_app|
lemma π23_ObjMap_app_0[cat_Kan_cs_simps]:
assumes "x = 0"
shows "π23β¦ObjMapβ¦β¦xβ¦ = 0"
by
(
cs_concl
cs_simp: π23_ObjMap_app cat_ordinal_cs_simps V_cs_simps assms
cs_intro: nat_omega_intros
)
lemma π23_ObjMap_app_1[cat_Kan_cs_simps]:
assumes "x = 1β©β"
shows "π23β¦ObjMapβ¦β¦xβ¦ = 2β©β"
by
(
cs_concl
cs_simp:
cat_ordinal_cs_simps V_cs_simps omega_of_set π23_ObjMap_app assms
cs_intro: nat_omega_intros V_cs_intros
)
subsubsectionβΉArrow mapβΊ
mk_VLambda π23_components(2)
|vsv π23_ArrMap_vsv[cat_Kan_cs_intros]|
|vdomain π23_ArrMap_vdomain[cat_Kan_cs_simps]|
|app π23_ArrMap_app|
lemma π23_ArrMap_app_00[cat_Kan_cs_simps]:
assumes "f = [0, 0]β©β"
shows "π23β¦ArrMapβ¦β¦fβ¦ = [0, 0]β©β"
unfolding assms
by
(
cs_concl
cs_simp: π23_ArrMap_app cat_ordinal_cs_simps V_cs_simps
cs_intro: cat_ordinal_cs_intros nat_omega_intros
)
lemma π23_ArrMap_app_01[cat_Kan_cs_simps]:
assumes "f = [0, 1β©β]β©β"
shows "π23β¦ArrMapβ¦β¦fβ¦ = [0, 2β©β]β©β"
proof-
have "[0, 1β©β]β©β ββ©β ordinal_arrs (2β©β)"
by
(
cs_concl
cs_simp: omega_of_set
cs_intro: cat_ordinal_cs_intros V_cs_intros nat_omega_intros
)
then show ?thesis
unfolding assms by (simp add: π23_components cat_ordinal_components)
qed
lemma π23_ArrMap_app_11[cat_Kan_cs_simps]:
assumes "f = [1β©β, 1β©β]β©β"
shows "π23β¦ArrMapβ¦β¦fβ¦ = [2β©β, 2β©β]β©β"
proof-
have "[1β©β, 1β©β]β©β ββ©β ordinal_arrs (2β©β)"
by
(
cs_concl
cs_simp: omega_of_set
cs_intro: cat_ordinal_cs_intros V_cs_intros nat_omega_intros
)
then show ?thesis
unfolding assms by (simp add: π23_components cat_ordinal_components)
qed
subsubsectionβΉβΉπ23βΊ is a tiny functorβΊ
lemma (in π΅) π23_is_functor: "π23 : cat_ordinal (2β©β) β¦β¦β©CβΞ±β cat_ordinal (3β©β)"
proof-
from ord_of_nat_Ο interpret cat_ordinal_2: finite_category Ξ± βΉcat_ordinal (2β©β)βΊ
by (cs_concl cs_intro: cat_ordinal_cs_intros)
from ord_of_nat_Ο interpret cat_ordinal_3: finite_category Ξ± βΉcat_ordinal (3β©β)βΊ
by (cs_concl cs_intro: cat_ordinal_cs_intros)
show ?thesis
proof(intro is_tiny_functorI' is_functorI')
show "vfsequence π23" unfolding π23_def by auto
show "vcard π23 = 4β©β" unfolding π23_def by (simp add: nat_omega_simps)
show "ββ©β (π23β¦ObjMapβ¦) ββ©β cat_ordinal (3β©β)β¦Objβ¦"
proof
(
rule vsv.vsv_vrange_vsubset,
unfold cat_Kan_cs_simps cat_ordinal_cs_simps,
intro cat_Kan_cs_intros
)
fix x assume "x ββ©β 2β©β"
then consider βΉx = 0βΊ | βΉx = 1β©ββΊ unfolding two by auto
then show "π23β¦ObjMapβ¦β¦xβ¦ ββ©β 3β©β"
by (cases, use nothing in βΉsimp_all only:βΊ)
(
cs_concl
cs_simp: cat_Kan_cs_simps omega_of_set cs_intro: nat_omega_intros
)+
qed
show "π23β¦ArrMapβ¦β¦fβ¦ : π23β¦ObjMapβ¦β¦aβ¦ β¦βcat_ordinal (3β©β)β π23β¦ObjMapβ¦β¦bβ¦"
if "f : a β¦βcat_ordinal (2β©β)β b" for a b f
using that
by (elim cat_ordinal_2_is_arrE; simp only:)
(
cs_concl
cs_simp: omega_of_set cat_Kan_cs_simps
cs_intro: nat_omega_intros V_cs_intros cat_ordinal_cs_intros
)
show
"π23β¦ArrMapβ¦β¦g ββ©Aβcat_ordinal (2β©β)β fβ¦ =
π23β¦ArrMapβ¦β¦gβ¦ ββ©Aβcat_ordinal (3β©β)β π23β¦ArrMapβ¦β¦fβ¦"
if "g : b β¦βcat_ordinal (2β©β)β c" and "f : a β¦βcat_ordinal (2β©β)β b"
for b c g a f
proof-
have "0 ββ©β 3β©β" "1β©β ββ©β 3β©β" "2β©β ββ©β 3β©β" by auto
then show ?thesis
using that
by (elim cat_ordinal_2_is_arrE; simp only:)
(
cs_concl
cs_simp: cat_ordinal_cs_simps cat_Kan_cs_simps
cs_intro: V_cs_intros cat_ordinal_cs_intros
)+
qed
show
"π23β¦ArrMapβ¦β¦cat_ordinal (2β©β)β¦CIdβ¦β¦cβ¦β¦ =
cat_ordinal (3β©β)β¦CIdβ¦β¦π23β¦ObjMapβ¦β¦cβ¦β¦"
if "c ββ©β cat_ordinal (2β©β)β¦Objβ¦" for c
proof-
from that consider βΉc = 0βΊ | βΉc = 1β©ββΊ
unfolding cat_ordinal_components(1) two by auto
then show ?thesis
by (cases, use nothing in βΉsimp_all only:βΊ)
(
cs_concl
cs_simp: omega_of_set cat_Kan_cs_simps cat_ordinal_cs_simps
cs_intro: nat_omega_intros cat_ordinal_cs_intros
)
qed
qed (auto intro!: cat_cs_intros simp: π23_components)
qed
lemma (in π΅) π23_is_functor'[cat_Kan_cs_intros]:
assumes "π' = cat_ordinal (2β©β)"
and "π
' = cat_ordinal (3β©β)"
shows "π23 : π' β¦β¦β©CβΞ±β π
'"
unfolding assms by (rule π23_is_functor)
lemmas [cat_Kan_cs_intros] = π΅.π23_is_functor'
lemma (in π΅) π23_is_tiny_functor:
"π23 : cat_ordinal (2β©β) β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β cat_ordinal (3β©β)"
proof-
from ord_of_nat_Ο interpret cat_ordinal_2: finite_category Ξ± βΉcat_ordinal (2β©β)βΊ
by (cs_concl cs_intro: cat_ordinal_cs_intros)
from ord_of_nat_Ο interpret cat_ordinal_3: finite_category Ξ± βΉcat_ordinal (3β©β)βΊ
by (cs_concl cs_intro: cat_ordinal_cs_intros)
show ?thesis
by (intro is_tiny_functorI' π23_is_functor)
(auto intro!: cat_small_cs_intros)
qed
lemma (in π΅) π23_is_tiny_functor'[cat_Kan_cs_intros]:
assumes "π' = cat_ordinal (2β©β)"
and "π
' = cat_ordinal (3β©β)"
shows "π23 : π' β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
'"
unfolding assms by (rule π23_is_tiny_functor)
lemmas [cat_Kan_cs_intros] = π΅.π23_is_tiny_functor'
subsectionβΉ
βΉLK23βΊ: the functor associated with the left Kan extension along \<^const>βΉπ23βΊ
βΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition LK23 :: "V β V"
where "LK23 π =
[
(
Ξ»aββ©βcat_ordinal (3β©β)β¦Objβ¦.
if a = 0 β πβ¦ObjMapβ¦β¦0β¦
| a = 1β©β β πβ¦ObjMapβ¦β¦0β¦
| a = 2β©β β πβ¦ObjMapβ¦β¦1β©ββ¦
| otherwise β πβ¦HomCodβ¦β¦Objβ¦
),
(
Ξ»fββ©βcat_ordinal (3β©β)β¦Arrβ¦.
if f = [0, 0]β©β β πβ¦ArrMapβ¦β¦0, 0β¦β©β
| f = [0, 1β©β]β©β β πβ¦ArrMapβ¦β¦0, 0β¦β©β
| f = [0, 2β©β]β©β β πβ¦ArrMapβ¦β¦0, 1β©ββ¦β©β
| f = [1β©β, 1β©β]β©β β πβ¦ArrMapβ¦β¦0, 0β¦β©β
| f = [1β©β, 2β©β]β©β β πβ¦ArrMapβ¦β¦0, 1β©ββ¦β©β
| f = [2β©β, 2β©β]β©β β πβ¦ArrMapβ¦β¦1β©β, 1β©ββ¦β©β
| otherwise β πβ¦HomCodβ¦β¦Arrβ¦
),
cat_ordinal (3β©β),
πβ¦HomCodβ¦
]β©β"
textβΉComponents.βΊ
lemma LK23_components:
shows "LK23 πβ¦ObjMapβ¦ =
(
Ξ»aββ©βcat_ordinal (3β©β)β¦Objβ¦.
if a = 0 β πβ¦ObjMapβ¦β¦0β¦
| a = 1β©β β πβ¦ObjMapβ¦β¦0β¦
| a = 2β©β β πβ¦ObjMapβ¦β¦1β©ββ¦
| otherwise β πβ¦HomCodβ¦β¦Objβ¦
)"
and "LK23 πβ¦ArrMapβ¦ =
(
Ξ»fββ©βcat_ordinal (3β©β)β¦Arrβ¦.
if f = [0, 0]β©β β πβ¦ArrMapβ¦β¦0, 0β¦β©β
| f = [0, 1β©β]β©β β πβ¦ArrMapβ¦β¦0, 0β¦β©β
| f = [0, 2β©β]β©β β πβ¦ArrMapβ¦β¦0, 1β©ββ¦β©β
| f = [1β©β, 1β©β]β©β β πβ¦ArrMapβ¦β¦0, 0β¦β©β
| f = [1β©β, 2β©β]β©β β πβ¦ArrMapβ¦β¦0, 1β©ββ¦β©β
| f = [2β©β, 2β©β]β©β β πβ¦ArrMapβ¦β¦1β©β, 1β©ββ¦β©β
| otherwise β πβ¦HomCodβ¦β¦Arrβ¦
)"
and "LK23 πβ¦HomDomβ¦ = cat_ordinal (3β©β)"
and "LK23 πβ¦HomCodβ¦ = πβ¦HomCodβ¦"
unfolding LK23_def dghm_field_simps by (simp_all add: nat_omega_simps)
context is_functor
begin
lemmas LK23_components' = LK23_components[where π=π, unfolded cat_cs_simps]
lemmas [cat_Kan_cs_simps] = LK23_components'(3,4)
end
lemmas [cat_Kan_cs_simps] = is_functor.LK23_components'(3,4)
subsubsectionβΉObject mapβΊ
mk_VLambda LK23_components(1)
|vsv LK23_ObjMap_vsv[cat_Kan_cs_intros]|
|vdomain LK23_ObjMap_vdomain[cat_Kan_cs_simps]|
|app LK23_ObjMap_app|
lemma LK23_ObjMap_app_0[cat_Kan_cs_simps]:
assumes "a = 0"
shows "LK23 πβ¦ObjMapβ¦β¦aβ¦ = πβ¦ObjMapβ¦β¦0β¦"
unfolding LK23_components assms cat_ordinal_components by simp
lemma LK23_ObjMap_app_1[cat_Kan_cs_simps]:
assumes "a = 1β©β"
shows "LK23 πβ¦ObjMapβ¦β¦aβ¦ = πβ¦ObjMapβ¦β¦0β¦"
unfolding LK23_components assms cat_ordinal_components by simp
lemma LK23_ObjMap_app_2[cat_Kan_cs_simps]:
assumes "a = 2β©β"
shows "LK23 πβ¦ObjMapβ¦β¦aβ¦ = πβ¦ObjMapβ¦β¦1β©ββ¦"
unfolding LK23_components assms cat_ordinal_components by simp
subsubsectionβΉArrow mapβΊ
mk_VLambda LK23_components(2)
|vsv LK23_ArrMap_vsv[cat_Kan_cs_intros]|
|vdomain LK23_ArrMap_vdomain[cat_Kan_cs_simps]|
|app LK23_ArrMap_app|
lemma LK23_ArrMap_app_00[cat_Kan_cs_simps]:
assumes "f = [0, 0]β©β"
shows "LK23 πβ¦ArrMapβ¦β¦fβ¦ = πβ¦ArrMapβ¦β¦0, 0β¦β©β"
proof-
from 0123 have f: "f ββ©β cat_ordinal (3β©β)β¦Arrβ¦"
by
(
cs_concl cs_simp: cs_intro:
V_cs_intros cat_ordinal_cs_intros cat_cs_intros assms
)
then show ?thesis unfolding LK23_components assms by auto
qed
lemma LK23_ArrMap_app_01[cat_Kan_cs_simps]:
assumes "f = [0, 1β©β]β©β"
shows "LK23 πβ¦ArrMapβ¦β¦fβ¦ = πβ¦ArrMapβ¦β¦0, 0β¦β©β"
proof-
from 0123 have f: "f ββ©β cat_ordinal (3β©β)β¦Arrβ¦"
by
(
cs_concl cs_simp: cs_intro:
V_cs_intros cat_ordinal_cs_intros cat_cs_intros assms
)
then show ?thesis unfolding LK23_components assms by auto
qed
lemma LK23_ArrMap_app_02[cat_Kan_cs_simps]:
assumes "f = [0, 2β©β]β©β"
shows "LK23 πβ¦ArrMapβ¦β¦fβ¦ = πβ¦ArrMapβ¦β¦0, 1β©ββ¦β©β"
proof-
from 0123 have f: "f ββ©β cat_ordinal (3β©β)β¦Arrβ¦"
by
(
cs_concl cs_simp: cs_intro:
V_cs_intros cat_ordinal_cs_intros cat_cs_intros assms
)
then show ?thesis unfolding LK23_components assms by auto
qed
lemma LK23_ArrMap_app_11[cat_Kan_cs_simps]:
assumes "f = [1β©β, 1β©β]β©β"
shows "LK23 πβ¦ArrMapβ¦β¦fβ¦ = πβ¦ArrMapβ¦β¦0, 0β¦β©β"
proof-
from 0123 have f: "f ββ©β cat_ordinal (3β©β)β¦Arrβ¦"
by
(
cs_concl cs_simp: cs_intro:
V_cs_intros cat_ordinal_cs_intros cat_cs_intros assms
)
then show ?thesis unfolding LK23_components assms by auto
qed
lemma LK23_ArrMap_app_12[cat_Kan_cs_simps]:
assumes "f = [1β©β, 2β©β]β©β"
shows "LK23 πβ¦ArrMapβ¦β¦fβ¦ = πβ¦ArrMapβ¦β¦0, 1β©ββ¦β©β"
proof-
from 0123 have f: "f ββ©β cat_ordinal (3β©β)β¦Arrβ¦"
by
(
cs_concl
cs_simp: omega_of_set
cs_intro: nat_omega_intros cat_ordinal_cs_intros cat_cs_intros assms
)
then show ?thesis unfolding LK23_components assms by auto
qed
lemma LK23_ArrMap_app_22[cat_Kan_cs_simps]:
assumes "f = [2β©β, 2β©β]β©β"
shows "LK23 πβ¦ArrMapβ¦β¦fβ¦ = πβ¦ArrMapβ¦β¦1β©β, 1β©ββ¦β©β"
proof-
from 0123 have f: "f ββ©β cat_ordinal (3β©β)β¦Arrβ¦"
by
(
cs_concl cs_simp: cs_intro:
nat_omega_intros cat_ordinal_cs_intros cat_cs_intros assms
)
then show ?thesis unfolding LK23_components assms by simp
qed
subsubsectionβΉβΉLK23βΊ is a functorβΊ
lemma cat_LK23_is_functor:
assumes "π : cat_ordinal (2β©β) β¦β¦β©CβΞ±β β"
shows "LK23 π : cat_ordinal (3β©β) β¦β¦β©CβΞ±β β"
proof-
interpret π: is_functor Ξ± βΉcat_ordinal (2β©β)βΊ β π by (rule assms(1))
from ord_of_nat_Ο interpret cat_ordinal_2: finite_category Ξ± βΉcat_ordinal (2β©β)βΊ
by (cs_concl cs_intro: cat_ordinal_cs_intros)
from ord_of_nat_Ο interpret cat_ordinal_3: finite_category Ξ± βΉcat_ordinal (3β©β)βΊ
by (cs_concl cs_intro: cat_ordinal_cs_intros)
interpret π: is_functor Ξ± βΉcat_ordinal (2β©β)βΊ β π by (rule assms)
show ?thesis
proof(intro is_functorI')
show "vfsequence (LK23 π)" unfolding LK23_def by auto
show "vcard (LK23 π) = 4β©β" unfolding LK23_def by (simp add: nat_omega_simps)
show "ββ©β (LK23 πβ¦ObjMapβ¦) ββ©β ββ¦Objβ¦"
proof(rule vsv.vsv_vrange_vsubset, unfold cat_Kan_cs_simps)
fix x assume prems: "x ββ©β cat_ordinal (3β©β)β¦Objβ¦"
then consider βΉx = 0βΊ | βΉx = 1β©ββΊ | βΉx = 2β©ββΊ
unfolding cat_ordinal_cs_simps three by auto
then show "LK23 πβ¦ObjMapβ¦β¦xβ¦ ββ©β ββ¦Objβ¦"
by cases
(
cs_concl
cs_simp: cat_Kan_cs_simps cat_ordinal_cs_simps omega_of_set
cs_intro: cat_cs_intros nat_omega_intros
)+
qed (cs_concl cs_intro: cat_Kan_cs_intros)
show "LK23 πβ¦ArrMapβ¦β¦fβ¦ : LK23 πβ¦ObjMapβ¦β¦aβ¦ β¦βββ LK23 πβ¦ObjMapβ¦β¦bβ¦"
if "f : a β¦βcat_ordinal (3β©β)β b" for a b f
proof-
from 0123 that show ?thesis
by (elim cat_ordinal_3_is_arrE; simp only:)
(
cs_concl
cs_simp: cat_Kan_cs_simps
cs_intro: V_cs_intros cat_cs_intros cat_ordinal_cs_intros
)+
qed
show
"LK23 πβ¦ArrMapβ¦β¦g ββ©Aβcat_ordinal (3β©β)β fβ¦ =
LK23 πβ¦ArrMapβ¦β¦gβ¦ ββ©Aβββ LK23 πβ¦ArrMapβ¦β¦fβ¦"
if "g : b β¦βcat_ordinal (3β©β)β c" and "f : a β¦βcat_ordinal (3β©β)β b"
for b c g a f
proof-
from 0123 that show ?thesis
by (elim cat_ordinal_3_is_arrE; simp only:; (solvesβΉsimpβΊ)?)
(
cs_concl
cs_simp:
cat_ordinal_cs_simps
cat_Kan_cs_simps
π.cf_ArrMap_Comp[symmetric]
cs_intro: V_cs_intros cat_cs_intros cat_ordinal_cs_intros
)+
qed
show "LK23 πβ¦ArrMapβ¦β¦cat_ordinal (3β©β)β¦CIdβ¦β¦cβ¦β¦ = ββ¦CIdβ¦β¦LK23 πβ¦ObjMapβ¦β¦cβ¦β¦"
if "c ββ©β cat_ordinal (3β©β)β¦Objβ¦" for c
proof-
from that consider βΉc = 0βΊ | βΉc = 1β©ββΊ | βΉc = 2β©ββΊ
unfolding cat_ordinal_components three by auto
moreover have "0 ββ©β 2β©β" "1β©β ββ©β 2β©β" "0 ββ©β 3β©β" "1β©β ββ©β 3β©β" "2β©β ββ©β 3β©β" by auto
ultimately show ?thesis
by (cases, use nothing in βΉsimp_all only:βΊ)
(
cs_concl
cs_simp:
cat_ordinal_cs_simps
cat_Kan_cs_simps
is_functor.cf_ObjMap_CId[symmetric]
cs_intro: V_cs_intros cat_cs_intros cat_ordinal_cs_intros
)+
qed
qed
(
cs_concl
cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros cat_Kan_cs_intros
)+
qed
lemma cat_LK23_is_functor'[cat_Kan_cs_intros]:
assumes "π : cat_ordinal (2β©β) β¦β¦β©CβΞ±β β"
and "π' = cat_ordinal (3β©β)"
shows "LK23 π : π' β¦β¦β©CβΞ±β β"
using assms(1) unfolding assms(2) by (rule cat_LK23_is_functor)
subsubsectionβΉThe fundamental property of βΉLK23βΊβΊ
lemma cf_comp_LK23_π23[cat_Kan_cs_simps]:
assumes "π : cat_ordinal (2β©β) β¦β¦β©CβΞ±β β"
shows "LK23 π ββ©Cβ©F π23 = π"
proof-
interpret π: is_functor Ξ± βΉcat_ordinal (2β©β)βΊ β π by (rule assms(1))
interpret π23: is_functor Ξ± βΉcat_ordinal (2β©β)βΊ βΉcat_ordinal (3β©β)βΊ βΉπ23βΊ
by (cs_concl cs_simp: cs_intro: cat_cs_intros cat_Kan_cs_intros)
interpret LK23: is_functor Ξ± βΉcat_ordinal (3β©β)βΊ β βΉLK23 πβΊ
by (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros cat_cs_intros)
show ?thesis
proof(rule cf_eqI)
show "π : cat_ordinal (2β©β) β¦β¦β©CβΞ±β β" by (rule assms)
have ObjMap_dom_lhs: "πβ©β ((LK23 π ββ©Cβ©F π23)β¦ObjMapβ¦) = 2β©β"
by
(
cs_concl
cs_simp: cat_cs_simps cat_ordinal_cs_simps cs_intro: cat_cs_intros
)
have ObjMap_dom_rhs: "πβ©β (πβ¦ObjMapβ¦) = 2β©β"
by (cs_concl cs_simp: cat_cs_simps cat_ordinal_cs_simps)
show "(LK23 π ββ©Cβ©F π23)β¦ObjMapβ¦ = πβ¦ObjMapβ¦"
proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
fix a assume prems: "a ββ©β 2β©β"
then consider βΉa = 0βΊ | βΉa = 1β©ββΊ by force
then show "(LK23 π ββ©Cβ©F π23)β¦ObjMapβ¦β¦aβ¦ = πβ¦ObjMapβ¦β¦aβ¦"
by (cases, use nothing in βΉsimp_all only:βΊ)
(
cs_concl
cs_simp:
omega_of_set cat_cs_simps cat_ordinal_cs_simps cat_Kan_cs_simps
cs_intro: cat_cs_intros nat_omega_intros
)+
qed (cs_concl cs_simp: cs_intro: cat_cs_intros V_cs_intros)+
have ArrMap_dom_lhs: "πβ©β ((LK23 π ββ©Cβ©F π23)β¦ArrMapβ¦) = cat_ordinal (2β©β)β¦Arrβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
have ArrMap_dom_rhs: "πβ©β (πβ¦ArrMapβ¦) = cat_ordinal (2β©β)β¦Arrβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "(LK23 π ββ©Cβ©F π23)β¦ArrMapβ¦ = πβ¦ArrMapβ¦"
proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
fix f assume prems: "f ββ©β cat_ordinal (2β©β)β¦Arrβ¦"
then obtain a b where "f : a β¦βcat_ordinal (2β©β)β b" by auto
then show "(LK23 π ββ©Cβ©F π23)β¦ArrMapβ¦β¦fβ¦ = πβ¦ArrMapβ¦β¦fβ¦"
by (elim cat_ordinal_2_is_arrE; simp only:)
(
cs_concl
cs_simp: cat_cs_simps cat_Kan_cs_simps cs_intro: cat_cs_intros
)+
qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros V_cs_intros)+
qed (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros cat_cs_intros)
qed
subsectionβΉ
βΉRK23βΊ: the functor associated with the right Kan extension along \<^const>βΉπ23βΊ
βΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition RK23 :: "V β V"
where "RK23 π =
[
(
Ξ»aββ©βcat_ordinal (3β©β)β¦Objβ¦.
if a = 0 β πβ¦ObjMapβ¦β¦0β¦
| a = 1β©β β πβ¦ObjMapβ¦β¦1β©ββ¦
| a = 2β©β β πβ¦ObjMapβ¦β¦1β©ββ¦
| otherwise β πβ¦HomCodβ¦β¦Objβ¦
),
(
Ξ»fββ©βcat_ordinal (3β©β)β¦Arrβ¦.
if f = [0, 0]β©β β πβ¦ArrMapβ¦β¦0, 0β¦β©β
| f = [0, 1β©β]β©β β πβ¦ArrMapβ¦β¦0, 1β©ββ¦β©β
| f = [0, 2β©β]β©β β πβ¦ArrMapβ¦β¦0, 1β©ββ¦β©β
| f = [1β©β, 1β©β]β©β β πβ¦ArrMapβ¦β¦1β©β, 1β©ββ¦β©β
| f = [1β©β, 2β©β]β©β β πβ¦ArrMapβ¦β¦1β©β, 1β©ββ¦β©β
| f = [2β©β, 2β©β]β©β β πβ¦ArrMapβ¦β¦1β©β, 1β©ββ¦β©β
| otherwise β πβ¦HomCodβ¦β¦Arrβ¦
),
cat_ordinal (3β©β),
πβ¦HomCodβ¦
]β©β"
textβΉComponents.βΊ
lemma RK23_components:
shows "RK23 πβ¦ObjMapβ¦ =
(
Ξ»aββ©βcat_ordinal (3β©β)β¦Objβ¦.
if a = 0 β πβ¦ObjMapβ¦β¦0β¦
| a = 1β©β β πβ¦ObjMapβ¦β¦1β©ββ¦
| a = 2β©β β πβ¦ObjMapβ¦β¦1β©ββ¦
| otherwise β πβ¦HomCodβ¦β¦Objβ¦
)"
and "RK23 πβ¦ArrMapβ¦ =
(
Ξ»fββ©βcat_ordinal (3β©β)β¦Arrβ¦.
if f = [0, 0]β©β β πβ¦ArrMapβ¦β¦0, 0β¦β©β
| f = [0, 1β©β]β©β β πβ¦ArrMapβ¦β¦0, 1β©ββ¦β©β
| f = [0, 2β©β]β©β β πβ¦ArrMapβ¦β¦0, 1β©ββ¦β©β
| f = [1β©β, 1β©β]β©β β πβ¦ArrMapβ¦β¦1β©β, 1β©ββ¦β©β
| f = [1β©β, 2β©β]β©β β πβ¦ArrMapβ¦β¦1β©β, 1β©ββ¦β©β
| f = [2β©β, 2β©β]β©β β πβ¦ArrMapβ¦β¦1β©β, 1β©ββ¦β©β
| otherwise β πβ¦HomCodβ¦β¦Arrβ¦
)"
and "RK23 πβ¦HomDomβ¦ = cat_ordinal (3β©β)"
and "RK23 πβ¦HomCodβ¦ = πβ¦HomCodβ¦"
unfolding RK23_def dghm_field_simps by (simp_all add: nat_omega_simps)
context is_functor
begin
lemmas RK23_components' = RK23_components[where π=π, unfolded cat_cs_simps]
lemmas [cat_Kan_cs_simps] = RK23_components'(3,4)
end
lemmas [cat_Kan_cs_simps] = is_functor.RK23_components'(3,4)
subsubsectionβΉObject mapβΊ
mk_VLambda RK23_components(1)
|vsv RK23_ObjMap_vsv[cat_Kan_cs_intros]|
|vdomain RK23_ObjMap_vdomain[cat_Kan_cs_simps]|
|app RK23_ObjMap_app|
lemma RK23_ObjMap_app_0[cat_Kan_cs_simps]:
assumes "a = 0"
shows "RK23 πβ¦ObjMapβ¦β¦aβ¦ = πβ¦ObjMapβ¦β¦0β¦"
unfolding RK23_components assms cat_ordinal_components by simp
lemma RK23_ObjMap_app_1[cat_Kan_cs_simps]:
assumes "a = 1β©β"
shows "RK23 πβ¦ObjMapβ¦β¦aβ¦ = πβ¦ObjMapβ¦β¦1β©ββ¦"
unfolding RK23_components assms cat_ordinal_components by simp
lemma RK23_ObjMap_app_2[cat_Kan_cs_simps]:
assumes "a = 2β©β"
shows "RK23 πβ¦ObjMapβ¦β¦aβ¦ = πβ¦ObjMapβ¦β¦1β©ββ¦"
unfolding RK23_components assms cat_ordinal_components by simp
subsubsectionβΉArrow mapβΊ
mk_VLambda RK23_components(2)
|vsv RK23_ArrMap_vsv[cat_Kan_cs_intros]|
|vdomain RK23_ArrMap_vdomain[cat_Kan_cs_simps]|
|app RK23_ArrMap_app|
lemma RK23_ArrMap_app_00[cat_Kan_cs_simps]:
assumes "f = [0, 0]β©β"
shows "RK23 πβ¦ArrMapβ¦β¦fβ¦ = πβ¦ArrMapβ¦β¦0, 0β¦β©β"
proof-
from 0123 have f: "f ββ©β cat_ordinal (3β©β)β¦Arrβ¦"
by
(
cs_concl cs_simp: cs_intro:
V_cs_intros cat_ordinal_cs_intros cat_cs_intros assms
)
then show ?thesis unfolding RK23_components assms by auto
qed
lemma RK23_ArrMap_app_01[cat_Kan_cs_simps]:
assumes "f = [0, 1β©β]β©β"
shows "RK23 πβ¦ArrMapβ¦β¦fβ¦ = πβ¦ArrMapβ¦β¦0, 1β©ββ¦β©β"
proof-
from 0123 have f: "f ββ©β cat_ordinal (3β©β)β¦Arrβ¦"
by
(
cs_concl cs_simp: cs_intro:
V_cs_intros cat_ordinal_cs_intros cat_cs_intros assms
)
then show ?thesis unfolding RK23_components assms by auto
qed
lemma RK23_ArrMap_app_02[cat_Kan_cs_simps]:
assumes "f = [0, 2β©β]β©β"
shows "RK23 πβ¦ArrMapβ¦β¦fβ¦ = πβ¦ArrMapβ¦β¦0, 1β©ββ¦β©β"
proof-
from 0123 have f: "f ββ©β cat_ordinal (3β©β)β¦Arrβ¦"
by
(
cs_concl cs_simp: cs_intro:
V_cs_intros cat_ordinal_cs_intros cat_cs_intros assms
)
then show ?thesis unfolding RK23_components assms by auto
qed
lemma RK23_ArrMap_app_11[cat_Kan_cs_simps]:
assumes "f = [1β©β, 1β©β]β©β"
shows "RK23 πβ¦ArrMapβ¦β¦fβ¦ = πβ¦ArrMapβ¦β¦1β©β, 1β©ββ¦β©β"
proof-
from 0123 have f: "f ββ©β cat_ordinal (3β©β)β¦Arrβ¦"
by
(
cs_concl cs_simp: cs_intro:
V_cs_intros cat_ordinal_cs_intros cat_cs_intros assms
)
then show ?thesis unfolding RK23_components assms by auto
qed
lemma RK23_ArrMap_app_12[cat_Kan_cs_simps]:
assumes "f = [1β©β, 2β©β]β©β"
shows "RK23 πβ¦ArrMapβ¦β¦fβ¦ = πβ¦ArrMapβ¦β¦1β©β, 1β©ββ¦β©β"
proof-
from 0123 have f: "f ββ©β cat_ordinal (3β©β)β¦Arrβ¦"
by
(
cs_concl
cs_simp: omega_of_set
cs_intro: nat_omega_intros cat_ordinal_cs_intros cat_cs_intros assms
)
then show ?thesis unfolding RK23_components assms by auto
qed
lemma RK23_ArrMap_app_22[cat_Kan_cs_simps]:
assumes "f = [2β©β, 2β©β]β©β"
shows "RK23 πβ¦ArrMapβ¦β¦fβ¦ = πβ¦ArrMapβ¦β¦1β©β, 1β©ββ¦β©β"
proof-
from 0123 have f: "f ββ©β cat_ordinal (3β©β)β¦Arrβ¦"
by
(
cs_concl cs_simp: cs_intro:
nat_omega_intros cat_ordinal_cs_intros cat_cs_intros assms
)
then show ?thesis unfolding RK23_components assms by simp
qed
subsubsectionβΉβΉRK23βΊ is a functorβΊ
lemma cat_RK23_is_functor:
assumes "π : cat_ordinal (2β©β) β¦β¦β©CβΞ±β β"
shows "RK23 π : cat_ordinal (3β©β) β¦β¦β©CβΞ±β β"
proof-
interpret π: is_functor Ξ± βΉcat_ordinal (2β©β)βΊ β π by (rule assms(1))
from ord_of_nat_Ο interpret cat_ordinal_2: finite_category Ξ± βΉcat_ordinal (2β©β)βΊ
by (cs_concl cs_intro: cat_ordinal_cs_intros)
from ord_of_nat_Ο interpret cat_ordinal_3: finite_category Ξ± βΉcat_ordinal (3β©β)βΊ
by (cs_concl cs_intro: cat_ordinal_cs_intros)
interpret π: is_functor Ξ± βΉcat_ordinal (2β©β)βΊ β π by (rule assms)
show ?thesis
proof(intro is_functorI')
show "vfsequence (RK23 π)" unfolding RK23_def by auto
show "vcard (RK23 π) = 4β©β" unfolding RK23_def by (simp add: nat_omega_simps)
show "ββ©β (RK23 πβ¦ObjMapβ¦) ββ©β ββ¦Objβ¦"
proof(rule vsv.vsv_vrange_vsubset, unfold cat_Kan_cs_simps)
fix x assume prems: "x ββ©β cat_ordinal (3β©β)β¦Objβ¦"
then consider βΉx = 0βΊ | βΉx = 1β©ββΊ | βΉx = 2β©ββΊ
unfolding cat_ordinal_cs_simps three by auto
then show "RK23 πβ¦ObjMapβ¦β¦xβ¦ ββ©β ββ¦Objβ¦"
by cases
(
cs_concl
cs_simp: cat_Kan_cs_simps cat_ordinal_cs_simps omega_of_set
cs_intro: cat_cs_intros nat_omega_intros
)+
qed (cs_concl cs_intro: cat_Kan_cs_intros)
show "RK23 πβ¦ArrMapβ¦β¦fβ¦ : RK23 πβ¦ObjMapβ¦β¦aβ¦ β¦βββ RK23 πβ¦ObjMapβ¦β¦bβ¦"
if "f : a β¦βcat_ordinal (3β©β)β b" for a b f
proof-
from 0123 that show ?thesis
by (elim cat_ordinal_3_is_arrE; simp only:)
(
cs_concl
cs_simp: cat_Kan_cs_simps
cs_intro: V_cs_intros cat_cs_intros cat_ordinal_cs_intros
)+
qed
show
"RK23 πβ¦ArrMapβ¦β¦g ββ©Aβcat_ordinal (3β©β)β fβ¦ =
RK23 πβ¦ArrMapβ¦β¦gβ¦ ββ©Aβββ RK23 πβ¦ArrMapβ¦β¦fβ¦"
if "g : b β¦βcat_ordinal (3β©β)β c" and "f : a β¦βcat_ordinal (3β©β)β b"
for b c g a f
using 0123 that
by (elim cat_ordinal_3_is_arrE; simp only:; (solvesβΉsimpβΊ)?)
(
cs_concl
cs_simp:
cat_ordinal_cs_simps
cat_Kan_cs_simps
π.cf_ArrMap_Comp[symmetric]
cs_intro: V_cs_intros cat_cs_intros cat_ordinal_cs_intros
)+
show "RK23 πβ¦ArrMapβ¦β¦cat_ordinal (3β©β)β¦CIdβ¦β¦cβ¦β¦ = ββ¦CIdβ¦β¦RK23 πβ¦ObjMapβ¦β¦cβ¦β¦"
if "c ββ©β cat_ordinal (3β©β)β¦Objβ¦" for c
proof-
from that consider βΉc = 0βΊ | βΉc = 1β©ββΊ | βΉc = 2β©ββΊ
unfolding cat_ordinal_components three by auto
then show ?thesis
by (cases, use 0123 in βΉsimp_all only:βΊ)
(
cs_concl
cs_simp:
cat_ordinal_cs_simps
cat_Kan_cs_simps
is_functor.cf_ObjMap_CId[symmetric]
cs_intro: V_cs_intros cat_cs_intros cat_ordinal_cs_intros
)+
qed
qed
(
cs_concl
cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros cat_Kan_cs_intros
)+
qed
lemma cat_RK23_is_functor'[cat_Kan_cs_intros]:
assumes "π : cat_ordinal (2β©β) β¦β¦β©CβΞ±β β"
and "π' = cat_ordinal (3β©β)"
shows "RK23 π : π' β¦β¦β©CβΞ±β β"
using assms(1) unfolding assms(2) by (rule cat_RK23_is_functor)
subsubsectionβΉThe fundamental property of βΉRK23βΊβΊ
lemma cf_comp_RK23_π23[cat_Kan_cs_simps]:
assumes "π : cat_ordinal (2β©β) β¦β¦β©CβΞ±β β"
shows "RK23 π ββ©Cβ©F π23 = π"
proof-
interpret π: is_functor Ξ± βΉcat_ordinal (2β©β)βΊ β π by (rule assms(1))
interpret π23: is_functor Ξ± βΉcat_ordinal (2β©β)βΊ βΉcat_ordinal (3β©β)βΊ βΉπ23βΊ
by (cs_concl cs_simp: cs_intro: cat_cs_intros cat_Kan_cs_intros)
interpret RK23: is_functor Ξ± βΉcat_ordinal (3β©β)βΊ β βΉRK23 πβΊ
by (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros cat_cs_intros)
show ?thesis
proof(rule cf_eqI)
show "π : cat_ordinal (2β©β) β¦β¦β©CβΞ±β β" by (rule assms)
have ObjMap_dom_lhs: "πβ©β ((RK23 π ββ©Cβ©F π23)β¦ObjMapβ¦) = 2β©β"
by
(
cs_concl
cs_simp: cat_cs_simps cat_ordinal_cs_simps cs_intro: cat_cs_intros
)
have ObjMap_dom_rhs: "πβ©β (πβ¦ObjMapβ¦) = 2β©β"
by (cs_concl cs_simp: cat_cs_simps cat_ordinal_cs_simps)
show "(RK23 π ββ©Cβ©F π23)β¦ObjMapβ¦ = πβ¦ObjMapβ¦"
proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
fix a assume prems: "a ββ©β 2β©β"
then consider βΉa = 0βΊ | βΉa = 1β©ββΊ by force
then show "(RK23 π ββ©Cβ©F π23)β¦ObjMapβ¦β¦aβ¦ = πβ¦ObjMapβ¦β¦aβ¦"
by (cases, use nothing in βΉsimp_all only:βΊ)
(
cs_concl
cs_simp:
omega_of_set cat_cs_simps cat_ordinal_cs_simps cat_Kan_cs_simps
cs_intro: cat_cs_intros nat_omega_intros
)+
qed (cs_concl cs_simp: cs_intro: cat_cs_intros V_cs_intros)+
have ArrMap_dom_lhs: "πβ©β ((RK23 π ββ©Cβ©F π23)β¦ArrMapβ¦) = cat_ordinal (2β©β)β¦Arrβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
have ArrMap_dom_rhs: "πβ©β (πβ¦ArrMapβ¦) = cat_ordinal (2β©β)β¦Arrβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "(RK23 π ββ©Cβ©F π23)β¦ArrMapβ¦ = πβ¦ArrMapβ¦"
proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
fix f assume prems: "f ββ©β cat_ordinal (2β©β)β¦Arrβ¦"
then obtain a b where "f : a β¦βcat_ordinal (2β©β)β b" by auto
then show "(RK23 π ββ©Cβ©F π23)β¦ArrMapβ¦β¦fβ¦ = πβ¦ArrMapβ¦β¦fβ¦"
by (elim cat_ordinal_2_is_arrE; simp only:)
(
cs_concl
cs_simp: cat_cs_simps cat_Kan_cs_simps cs_intro: cat_cs_intros
)+
qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros V_cs_intros)+
qed (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros cat_cs_intros)
qed
subsectionβΉ
βΉRK_Ο23βΊ: towards the universal property of the right Kan extension along βΉπ23βΊ
βΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition RK_Ο23 :: "V β V β V β V"
where "RK_Ο23 π Ξ΅' π' =
[
(
Ξ»aββ©βcat_ordinal (3β©β)β¦Objβ¦.
if a = 0 β Ξ΅'β¦NTMapβ¦β¦0β¦
| a = 1β©β β Ξ΅'β¦NTMapβ¦β¦1β©ββ¦ ββ©Aβπβ¦HomCodβ¦β π'β¦ArrMapβ¦β¦1β©β, 2β©ββ¦β©β
| a = 2β©β β Ξ΅'β¦NTMapβ¦β¦1β©ββ¦
| otherwise β πβ¦HomCodβ¦β¦Arrβ¦
),
π',
RK23 π,
cat_ordinal (3β©β),
π'β¦HomCodβ¦
]β©β"
textβΉComponents.βΊ
lemma RK_Ο23_components:
shows "RK_Ο23 π Ξ΅' π'β¦NTMapβ¦ =
(
Ξ»aββ©βcat_ordinal (3β©β)β¦Objβ¦.
if a = 0 β Ξ΅'β¦NTMapβ¦β¦0β¦
| a = 1β©β β Ξ΅'β¦NTMapβ¦β¦1β©ββ¦ ββ©Aβπβ¦HomCodβ¦β π'β¦ArrMapβ¦β¦1β©β, 2β©ββ¦β©β
| a = 2β©β β Ξ΅'β¦NTMapβ¦β¦1β©ββ¦
| otherwise β πβ¦HomCodβ¦β¦Arrβ¦
)"
and "RK_Ο23 π Ξ΅' π'β¦NTDomβ¦ = π'"
and "RK_Ο23 π Ξ΅' π'β¦NTCodβ¦ = RK23 π"
and "RK_Ο23 π Ξ΅' π'β¦NTDGDomβ¦ = cat_ordinal (3β©β)"
and "RK_Ο23 π Ξ΅' π'β¦NTDGCodβ¦ = π'β¦HomCodβ¦"
unfolding RK_Ο23_def nt_field_simps by (simp_all add: nat_omega_simps)
context
fixes Ξ± π π' π
assumes π': "π' : cat_ordinal (3β©β) β¦β¦β©CβΞ±β π"
and π: "π : cat_ordinal (2β©β) β¦β¦β©CβΞ±β π"
begin
interpretation π': is_functor Ξ± βΉcat_ordinal (3β©β)βΊ π π' by (rule π')
interpretation π: is_functor Ξ± βΉcat_ordinal (2β©β)βΊ π π by (rule π)
lemmas RK_Ο23_components' =
RK_Ο23_components[where π'=π' and π=π, unfolded cat_cs_simps]
lemmas [cat_Kan_cs_simps] = RK_Ο23_components'(2-5)
end
subsubsectionβΉNatural transformation mapβΊ
mk_VLambda RK_Ο23_components(1)
|vsv RK_Ο23_NTMap_vsv[cat_Kan_cs_intros]|
|vdomain RK_Ο23_NTMap_vdomain[cat_Kan_cs_simps]|
|app RK_Ο23_NTMap_app|
lemma RK_Ο23_NTMap_app_0[cat_Kan_cs_simps]:
assumes "a = 0"
shows "RK_Ο23 π Ξ΅' π'β¦NTMapβ¦β¦aβ¦ = Ξ΅'β¦NTMapβ¦β¦0β¦"
using assms unfolding RK_Ο23_components cat_ordinal_cs_simps by simp
lemma (in is_functor) RK_Ο23_NTMap_app_1[cat_Kan_cs_simps]:
assumes "a = 1β©β"
shows "RK_Ο23 π Ξ΅' π'β¦NTMapβ¦β¦aβ¦ = Ξ΅'β¦NTMapβ¦β¦1β©ββ¦ ββ©Aβπ
β π'β¦ArrMapβ¦β¦1β©β, 2β©ββ¦β©β"
using assms
unfolding RK_Ο23_components cat_ordinal_cs_simps cat_cs_simps
by simp
lemmas [cat_Kan_cs_simps] = is_functor.RK_Ο23_NTMap_app_1
lemma RK_Ο23_NTMap_app_2[cat_Kan_cs_simps]:
assumes "a = 2β©β"
shows "RK_Ο23 π Ξ΅' π'β¦NTMapβ¦β¦aβ¦ = Ξ΅'β¦NTMapβ¦β¦1β©ββ¦"
using assms unfolding RK_Ο23_components cat_ordinal_cs_simps by simp
subsubsectionβΉβΉRK_Ο23βΊ is a natural transformationβΊ
lemma RK_Ο23_is_ntcf:
assumes "π' : cat_ordinal (3β©β) β¦β¦β©CβΞ±β π"
and "π : cat_ordinal (2β©β) β¦β¦β©CβΞ±β π"
and "Ξ΅' : π' ββ©Cβ©F π23 β¦β©Cβ©F π : cat_ordinal (2β©β) β¦β¦β©CβΞ±β π"
shows "RK_Ο23 π Ξ΅' π' : π' β¦β©Cβ©F RK23 π : cat_ordinal (3β©β) β¦β¦β©CβΞ±β π"
proof-
interpret π': is_functor Ξ± βΉcat_ordinal (3β©β)βΊ π π' by (rule assms(1))
interpret π: is_functor Ξ± βΉcat_ordinal (2β©β)βΊ π π by (rule assms(2))
interpret Ξ΅': is_ntcf Ξ± βΉcat_ordinal (2β©β)βΊ π βΉπ' ββ©Cβ©F π23βΊ π Ξ΅'
by (rule assms(3))
interpret π23: is_functor Ξ± βΉcat_ordinal (2β©β)βΊ βΉcat_ordinal (3β©β)βΊ βΉπ23βΊ
by (cs_concl cs_simp: cs_intro: cat_cs_intros cat_Kan_cs_intros)
interpret RK23: is_functor Ξ± βΉcat_ordinal (3β©β)βΊ π βΉRK23 πβΊ
by (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros cat_cs_intros)
from 0123 have [cat_cs_simps]: "πβ¦ArrMapβ¦β¦1β©β, 1β©ββ¦β©β = πβ¦CIdβ¦β¦πβ¦ObjMapβ¦β¦1β©ββ¦β¦"
by
(
cs_concl
cs_simp: cat_ordinal_cs_simps is_functor.cf_ObjMap_CId[symmetric]
cs_intro: cat_cs_intros
)
show ?thesis
proof(rule is_ntcfI')
show "vfsequence (RK_Ο23 π Ξ΅' π')" unfolding RK_Ο23_def by simp
show "vcard (RK_Ο23 π Ξ΅' π') = 5β©β"
unfolding RK_Ο23_def by (simp_all add: nat_omega_simps)
show "RK_Ο23 π Ξ΅' π'β¦NTMapβ¦β¦aβ¦ : π'β¦ObjMapβ¦β¦aβ¦ β¦βπβ RK23 πβ¦ObjMapβ¦β¦aβ¦"
if "a ββ©β cat_ordinal (3β©β)β¦Objβ¦" for a
proof-
from that consider βΉa = 0βΊ | βΉa = 1β©ββΊ | βΉa = 2β©ββΊ
unfolding cat_ordinal_cs_simps three by auto
from this 0123 show ?thesis
by (cases, use nothing in βΉsimp_all only:βΊ)
(
cs_concl
cs_simp: cat_cs_simps cat_ordinal_cs_simps cat_Kan_cs_simps
cs_intro:
cat_cs_intros
cat_ordinal_cs_intros
cat_Kan_cs_intros
nat_omega_intros
)+
qed
show
"RK_Ο23 π Ξ΅' π'β¦NTMapβ¦β¦bβ¦ ββ©Aβπβ π'β¦ArrMapβ¦β¦fβ¦ =
RK23 πβ¦ArrMapβ¦β¦fβ¦ ββ©Aβπβ RK_Ο23 π Ξ΅' π'β¦NTMapβ¦β¦aβ¦"
if "f : a β¦βcat_ordinal (3β©β)β b" for a b f
using that 0123
by (elim cat_ordinal_3_is_arrE, use nothing in βΉsimp_all only:βΊ)
(
cs_concl
cs_simp:
cat_cs_simps
cat_ordinal_cs_simps
π'.cf_ArrMap_Comp[symmetric]
π'.HomCod.cat_Comp_assoc
Ξ΅'.ntcf_Comp_commute[symmetric]
cat_Kan_cs_simps
cs_intro: cat_cs_intros cat_ordinal_cs_intros nat_omega_intros
)+
qed
(
cs_concl
cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros cat_Kan_cs_intros
)+
qed
lemma RK_Ο23_is_ntcf'[cat_Kan_cs_intros]:
assumes "π' : cat_ordinal (3β©β) β¦β¦β©CβΞ±β π"
and "π : cat_ordinal (2β©β) β¦β¦β©CβΞ±β π"
and "Ξ΅' : π' ββ©Cβ©F π23 β¦β©Cβ©F π : cat_ordinal (2β©β) β¦β¦β©CβΞ±β π"
and "π' = π'"
and "β' = RK23 π"
and "β' = cat_ordinal (3β©β)"
shows "RK_Ο23 π Ξ΅' π' : π' β¦β©Cβ©F β': β' β¦β¦β©CβΞ±β π"
using assms(1-3) unfolding assms(4-6) by (rule RK_Ο23_is_ntcf)
subsectionβΉThe right Kan extension along βΉπ23βΊβΊ
lemma Ξ΅23_is_cat_rKe:
assumes "π : cat_ordinal (2β©β) β¦β¦β©CβΞ±β π"
shows "ntcf_id π :
RK23 π ββ©Cβ©F π23 β¦β©Cβ©Fβ©.β©rβ©Kβ©eβΞ±β π : cat_ordinal (2β©β) β¦β©C cat_ordinal (3β©β) β¦β©C π"
proof-
interpret π: is_functor Ξ± βΉcat_ordinal (2β©β)βΊ π π by (rule assms(1))
interpret π23: is_functor Ξ± βΉcat_ordinal (2β©β)βΊ βΉcat_ordinal (3β©β)βΊ βΉπ23βΊ
by (cs_concl cs_simp: cs_intro: cat_cs_intros cat_Kan_cs_intros)
interpret RK23: is_functor Ξ± βΉcat_ordinal (3β©β)βΊ π βΉRK23 πβΊ
by (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros cat_cs_intros)
from 0123 have [cat_cs_simps]: "πβ¦ArrMapβ¦β¦1β©β, 1β©ββ¦β©β = πβ¦CIdβ¦β¦πβ¦ObjMapβ¦β¦1β©ββ¦β¦"
by
(
cs_concl
cs_simp: cat_ordinal_cs_simps is_functor.cf_ObjMap_CId[symmetric]
cs_intro: cat_cs_intros
)
show ?thesis
proof(intro is_cat_rKeI')
fix π' Ξ΅' assume prems:
"π' : cat_ordinal (3β©β) β¦β¦β©CβΞ±β π"
"Ξ΅' : π' ββ©Cβ©F π23 β¦β©Cβ©F π : cat_ordinal (2β©β) β¦β¦β©CβΞ±β π"
interpret π': is_functor Ξ± βΉcat_ordinal (3β©β)βΊ π π' by (rule prems(1))
interpret Ξ΅': is_ntcf Ξ± βΉcat_ordinal (2β©β)βΊ π βΉπ' ββ©Cβ©F π23βΊ π Ξ΅'
by (rule prems(2))
interpret RK_Ο23: is_ntcf Ξ± βΉcat_ordinal (3β©β)βΊ π π' βΉRK23 πβΊ βΉRK_Ο23 π Ξ΅' π'βΊ
by (intro RK_Ο23_is_ntcf prems assms)
show "β!Ο.
Ο : π' β¦β©Cβ©F RK23 π : cat_ordinal (3β©β) β¦β¦β©CβΞ±β π β§
Ξ΅' = ntcf_id π ββ©Nβ©Tβ©Cβ©F (Ο ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π23)"
proof(intro ex1I conjI; (elim conjE)?)
show "RK_Ο23 π Ξ΅' π' : π' β¦β©Cβ©F RK23 π : cat_ordinal (3β©β) β¦β¦β©CβΞ±β π"
by (intro RK_Ο23.is_ntcf_axioms)
show "Ξ΅' = ntcf_id π ββ©Nβ©Tβ©Cβ©F (RK_Ο23 π Ξ΅' π' ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π23)"
proof(rule ntcf_eqI)
show "Ξ΅' : π' ββ©Cβ©F π23 β¦β©Cβ©F π : cat_ordinal (2β©β) β¦β¦β©CβΞ±β π"
by (intro prems)
then have dom_lhs: "πβ©β (Ξ΅'β¦NTMapβ¦) = 2β©β"
by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
show rhs:
"ntcf_id π ββ©Nβ©Tβ©Cβ©F (RK_Ο23 π Ξ΅' π' ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π23) :
π' ββ©Cβ©F π23 β¦β©Cβ©F π : cat_ordinal (2β©β) β¦β¦β©CβΞ±β π"
by
(
cs_concl
cs_simp: cat_Kan_cs_simps cat_cs_simps
cs_intro: cat_Kan_cs_intros cat_cs_intros
)
then have dom_rhs:
"πβ©β ((ntcf_id π ββ©Nβ©Tβ©Cβ©F (RK_Ο23 π Ξ΅' π' ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π23))β¦NTMapβ¦) = 2β©β"
by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
show "Ξ΅'β¦NTMapβ¦ = (ntcf_id π ββ©Nβ©Tβ©Cβ©F (RK_Ο23 π Ξ΅' π' ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π23))β¦NTMapβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix a assume prems: "a ββ©β 2β©β"
then consider βΉa = 0βΊ | βΉa = 1β©ββΊ unfolding two by auto
then show
"Ξ΅'β¦NTMapβ¦β¦aβ¦ =
(ntcf_id π ββ©Nβ©Tβ©Cβ©F (RK_Ο23 π Ξ΅' π' ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π23))β¦NTMapβ¦β¦aβ¦"
by (cases; use nothing in βΉsimp_all only:βΊ)
(
cs_concl
cs_simp:
omega_of_set
cat_Kan_cs_simps
cat_cs_simps
cat_ordinal_cs_simps
cs_intro: cat_Kan_cs_intros cat_cs_intros nat_omega_intros
)+
qed (use rhs in βΉcs_concl cs_simp: cs_intro: V_cs_intros cat_cs_introsβΊ)+
qed simp_all
fix Ο assume prems':
"Ο : π' β¦β©Cβ©F RK23 π : cat_ordinal (3β©β) β¦β¦β©CβΞ±β π"
"Ξ΅' = ntcf_id π ββ©Nβ©Tβ©Cβ©F (Ο ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π23)"
interpret Ο: is_ntcf Ξ± βΉcat_ordinal (3β©β)βΊ π π' βΉRK23 πβΊ Ο
by (rule prems'(1))
from prems'(2) have
"Ξ΅'β¦NTMapβ¦β¦0β¦ = (ntcf_id π ββ©Nβ©Tβ©Cβ©F (Ο ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π23))β¦NTMapβ¦β¦0β¦"
by auto
then have [cat_cs_simps]: "Ξ΅'β¦NTMapβ¦β¦0β¦ = Οβ¦NTMapβ¦β¦0β¦"
by
(
cs_prems
cs_simp: cat_Kan_cs_simps cat_cs_simps cat_ordinal_cs_simps
cs_intro: cat_cs_intros nat_omega_intros
)
from prems'(2) have
"Ξ΅'β¦NTMapβ¦β¦1β©ββ¦ = (ntcf_id π ββ©Nβ©Tβ©Cβ©F (Ο ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π23))β¦NTMapβ¦β¦1β©ββ¦"
by auto
then have [cat_cs_simps]: "Ξ΅'β¦NTMapβ¦β¦1β©ββ¦ = Οβ¦NTMapβ¦β¦2β©ββ¦"
by
(
cs_prems
cs_simp:
omega_of_set cat_Kan_cs_simps cat_cs_simps cat_ordinal_cs_simps
cs_intro: cat_cs_intros nat_omega_intros
)
show "Ο = RK_Ο23 π Ξ΅' π'"
proof(rule ntcf_eqI)
show "Ο : π' β¦β©Cβ©F RK23 π : cat_ordinal (3β©β) β¦β¦β©CβΞ±β π"
by (rule prems'(1))
then have dom_lhs: "πβ©β (Οβ¦NTMapβ¦) = 3β©β"
by (cs_concl cs_simp: cat_cs_simps cat_ordinal_cs_simps)
show "RK_Ο23 π Ξ΅' π' : π' β¦β©Cβ©F RK23 π : cat_ordinal (3β©β) β¦β¦β©CβΞ±β π"
by (cs_concl cs_simp: cs_intro: cat_cs_intros cat_Kan_cs_intros)
then have dom_rhs: "πβ©β (RK_Ο23 π Ξ΅' π'β¦NTMapβ¦) = 3β©β"
by (cs_concl cs_simp: cat_cs_simps cat_ordinal_cs_simps)
from 0123 have 013: "[0, 1β©β]β©β : 0 β¦βcat_ordinal (3β©β)β 1β©β"
by (cs_concl cs_simp: cs_intro: cat_ordinal_cs_intros nat_omega_intros)
from 0123 have 123: "[1β©β, 2β©β]β©β : 1β©β β¦βcat_ordinal (3β©β)β 2β©β"
by (cs_concl cs_simp: cs_intro: cat_ordinal_cs_intros nat_omega_intros)
from Ο.ntcf_Comp_commute[OF 123] 013 0123
have [symmetric, cat_Kan_cs_simps]:
"Οβ¦NTMapβ¦β¦2β©ββ¦ ββ©Aβπβ π'β¦ArrMapβ¦ β¦1β©β, 2β©ββ¦β©β = Οβ¦NTMapβ¦β¦1β©ββ¦"
by
(
cs_prems
cs_simp: cat_cs_simps cat_Kan_cs_simps RK23_ArrMap_app_12
cs_intro: cat_cs_intros
)
show "Οβ¦NTMapβ¦ = RK_Ο23 π Ξ΅' π'β¦NTMapβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix a assume prems: "a ββ©β 3β©β"
then consider βΉa = 0βΊ | βΉa = 1β©ββΊ | βΉa = 2β©ββΊ unfolding three by auto
then show "Οβ¦NTMapβ¦β¦aβ¦ = RK_Ο23 π Ξ΅' π'β¦NTMapβ¦β¦aβ¦"
by (cases; use nothing in βΉsimp_all only:βΊ)
(cs_concl cs_simp: cat_cs_simps cat_Kan_cs_simps)+
qed auto
qed simp_all
qed
qed (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)+
qed
subsectionβΉ
βΉLK_Ο23βΊ: towards the universal property of the left Kan extension along βΉπ23βΊ
βΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition LK_Ο23 :: "V β V β V β V"
where "LK_Ο23 π Ξ·' π' =
[
(
Ξ»aββ©βcat_ordinal (3β©β)β¦Objβ¦.
if a = 0 β Ξ·'β¦NTMapβ¦β¦0β¦
| a = 1β©β β π'β¦ArrMapβ¦β¦0, 1β©ββ¦β©β ββ©Aβπβ¦HomCodβ¦β Ξ·'β¦NTMapβ¦β¦0β¦
| a = 2β©β β Ξ·'β¦NTMapβ¦β¦1β©ββ¦
| otherwise β πβ¦HomCodβ¦β¦Arrβ¦
),
LK23 π,
π',
cat_ordinal (3β©β),
π'β¦HomCodβ¦
]β©β"
textβΉComponents.βΊ
lemma LK_Ο23_components:
shows "LK_Ο23 π Ξ·' π'β¦NTMapβ¦ =
(
Ξ»aββ©βcat_ordinal (3β©β)β¦Objβ¦.
if a = 0 β Ξ·'β¦NTMapβ¦β¦0β¦
| a = 1β©β β π'β¦ArrMapβ¦β¦0, 1β©ββ¦β©β ββ©Aβπβ¦HomCodβ¦β Ξ·'β¦NTMapβ¦β¦0β¦
| a = 2β©β β Ξ·'β¦NTMapβ¦β¦1β©ββ¦
| otherwise β πβ¦HomCodβ¦β¦Arrβ¦
)"
and "LK_Ο23 π Ξ·' π'β¦NTDomβ¦ = LK23 π"
and "LK_Ο23 π Ξ·' π'β¦NTCodβ¦ = π'"
and "LK_Ο23 π Ξ·' π'β¦NTDGDomβ¦ = cat_ordinal (3β©β)"
and "LK_Ο23 π Ξ·' π'β¦NTDGCodβ¦ = π'β¦HomCodβ¦"
unfolding LK_Ο23_def nt_field_simps by (simp_all add: nat_omega_simps)
context
fixes Ξ± π π' π
assumes π': "π' : cat_ordinal (3β©β) β¦β¦β©CβΞ±β π"
and π: "π : cat_ordinal (2β©β) β¦β¦β©CβΞ±β π"
begin
interpretation π': is_functor Ξ± βΉcat_ordinal (3β©β)βΊ π π' by (rule π')
interpretation π: is_functor Ξ± βΉcat_ordinal (2β©β)βΊ π π by (rule π)
lemmas LK_Ο23_components' =
LK_Ο23_components[where π'=π' and π=π, unfolded cat_cs_simps]
lemmas [cat_Kan_cs_simps] = LK_Ο23_components'(2-5)
end
subsubsectionβΉNatural transformation mapβΊ
mk_VLambda LK_Ο23_components(1)
|vsv LK_Ο23_NTMap_vsv[cat_Kan_cs_intros]|
|vdomain LK_Ο23_NTMap_vdomain[cat_Kan_cs_simps]|
|app LK_Ο23_NTMap_app|
lemma LK_Ο23_NTMap_app_0[cat_Kan_cs_simps]:
assumes "a = 0"
shows "LK_Ο23 π Ξ·' π'β¦NTMapβ¦β¦aβ¦ = Ξ·'β¦NTMapβ¦β¦0β¦"
using assms unfolding LK_Ο23_components cat_ordinal_cs_simps by simp
lemma (in is_functor) LK_Ο23_NTMap_app_1[cat_Kan_cs_simps]:
assumes "a = 1β©β"
shows "LK_Ο23 π Ξ·' π'β¦NTMapβ¦β¦aβ¦ = π'β¦ArrMapβ¦β¦0, 1β©ββ¦β©β ββ©Aβπ
β Ξ·'β¦NTMapβ¦β¦0β¦"
using assms unfolding LK_Ο23_components cat_ordinal_cs_simps cat_cs_simps by simp
lemmas [cat_Kan_cs_simps] = is_functor.LK_Ο23_NTMap_app_1
lemma LK_Ο23_NTMap_app_2[cat_Kan_cs_simps]:
assumes "a = 2β©β"
shows "LK_Ο23 π Ξ·' π'β¦NTMapβ¦β¦aβ¦ = Ξ·'β¦NTMapβ¦β¦1β©ββ¦"
using assms unfolding LK_Ο23_components cat_ordinal_cs_simps by simp
subsubsectionβΉβΉLK_Ο23βΊ is a natural transformationβΊ
lemma LK_Ο23_is_ntcf:
assumes "π' : cat_ordinal (3β©β) β¦β¦β©CβΞ±β π"
and "π : cat_ordinal (2β©β) β¦β¦β©CβΞ±β π"
and "Ξ·' : π β¦β©Cβ©F π' ββ©Cβ©F π23 : cat_ordinal (2β©β) β¦β¦β©CβΞ±β π"
shows "LK_Ο23 π Ξ·' π' : LK23 π β¦β©Cβ©F π' : cat_ordinal (3β©β) β¦β¦β©CβΞ±β π"
proof-
interpret π': is_functor Ξ± βΉcat_ordinal (3β©β)βΊ π π' by (rule assms(1))
interpret π: is_functor Ξ± βΉcat_ordinal (2β©β)βΊ π π by (rule assms(2))
interpret Ξ·': is_ntcf Ξ± βΉcat_ordinal (2β©β)βΊ π π βΉπ' ββ©Cβ©F π23βΊ Ξ·'
by (rule assms(3))
interpret π23: is_functor Ξ± βΉcat_ordinal (2β©β)βΊ βΉcat_ordinal (3β©β)βΊ βΉπ23βΊ
by (cs_concl cs_simp: cs_intro: cat_cs_intros cat_Kan_cs_intros)
interpret LK23: is_functor Ξ± βΉcat_ordinal (3β©β)βΊ π βΉLK23 πβΊ
by (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros cat_cs_intros)
show ?thesis
proof(rule is_ntcfI')
show "vfsequence (LK_Ο23 π Ξ·' π')" unfolding LK_Ο23_def by simp
show "vcard (LK_Ο23 π Ξ·' π') = 5β©β"
unfolding LK_Ο23_def by (simp_all add: nat_omega_simps)
show "LK_Ο23 π Ξ·' π'β¦NTMapβ¦β¦aβ¦ : LK23 πβ¦ObjMapβ¦β¦aβ¦ β¦βπβ π'β¦ObjMapβ¦β¦aβ¦"
if "a ββ©β cat_ordinal (3β©β)β¦Objβ¦" for a
proof-
from that consider βΉa = 0βΊ | βΉa = 1β©ββΊ | βΉa = 2β©ββΊ
unfolding cat_ordinal_cs_simps three by auto
from this 0123 show
"LK_Ο23 π Ξ·' π'β¦NTMapβ¦β¦aβ¦ : LK23 πβ¦ObjMapβ¦β¦aβ¦ β¦βπβ π'β¦ObjMapβ¦β¦aβ¦"
by (cases, use nothing in βΉsimp_all only:βΊ)
(
cs_concl
cs_simp: cat_cs_simps cat_ordinal_cs_simps cat_Kan_cs_simps
cs_intro:
cat_cs_intros
cat_ordinal_cs_intros
cat_Kan_cs_intros
nat_omega_intros
)+
qed
show
"LK_Ο23 π Ξ·' π'β¦NTMapβ¦β¦bβ¦ ββ©Aβπβ LK23 πβ¦ArrMapβ¦β¦fβ¦ =
π'β¦ArrMapβ¦β¦fβ¦ ββ©Aβπβ LK_Ο23 π Ξ·' π'β¦NTMapβ¦β¦aβ¦"
if "f : a β¦βcat_ordinal (3β©β)β b" for a b f
using that 0123
by (elim cat_ordinal_3_is_arrE, use nothing in βΉsimp_all only:βΊ)
(
cs_concl
cs_simp:
cat_cs_simps
cat_ordinal_cs_simps
π'.cf_ArrMap_Comp[symmetric]
π'.HomCod.cat_Comp_assoc[symmetric]
Ξ·'.ntcf_Comp_commute
cat_Kan_cs_simps
cs_intro: cat_cs_intros cat_ordinal_cs_intros nat_omega_intros
)+
qed
(
cs_concl
cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros cat_Kan_cs_intros
)+
qed
lemma LK_Ο23_is_ntcf'[cat_Kan_cs_intros]:
assumes "π' : cat_ordinal (3β©β) β¦β¦β©CβΞ±β π"
and "π : cat_ordinal (2β©β) β¦β¦β©CβΞ±β π"
and "Ξ·' : π β¦β©Cβ©F π' ββ©Cβ©F π23 : cat_ordinal (2β©β) β¦β¦β©CβΞ±β π"
and "π' = LK23 π"
and "β' = π'"
and "β' = cat_ordinal (3β©β)"
shows "LK_Ο23 π Ξ·' π' : π' β¦β©Cβ©F β': β' β¦β¦β©CβΞ±β π"
using assms(1-3) unfolding assms(4-6) by (rule LK_Ο23_is_ntcf)
subsectionβΉThe left Kan extension along βΉπ23βΊβΊ
lemma Ξ·23_is_cat_rKe:
assumes "π : cat_ordinal (2β©β) β¦β¦β©CβΞ±β π"
shows "ntcf_id π :
π β¦β©Cβ©Fβ©.β©lβ©Kβ©eβΞ±β LK23 π ββ©Cβ©F π23 : cat_ordinal (2β©β) β¦β©C cat_ordinal (3β©β) β¦β©C π"
proof-
interpret π: is_functor Ξ± βΉcat_ordinal (2β©β)βΊ π π by (rule assms(1))
interpret π23: is_functor Ξ± βΉcat_ordinal (2β©β)βΊ βΉcat_ordinal (3β©β)βΊ βΉπ23βΊ
by (cs_concl cs_simp: cs_intro: cat_cs_intros cat_Kan_cs_intros)
interpret LK23: is_functor Ξ± βΉcat_ordinal (3β©β)βΊ π βΉLK23 πβΊ
by (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros cat_cs_intros)
show ?thesis
proof(intro is_cat_lKeI')
fix π' Ξ·' assume prems:
"π' : cat_ordinal (3β©β) β¦β¦β©CβΞ±β π"
"Ξ·' : π β¦β©Cβ©F π' ββ©Cβ©F π23 : cat_ordinal (2β©β) β¦β¦β©CβΞ±β π"
interpret π': is_functor Ξ± βΉcat_ordinal (3β©β)βΊ π π' by (rule prems(1))
interpret Ξ·': is_ntcf Ξ± βΉcat_ordinal (2β©β)βΊ π π βΉπ' ββ©Cβ©F π23βΊ Ξ·'
by (rule prems(2))
interpret LK_Ο23: is_ntcf Ξ± βΉcat_ordinal (3β©β)βΊ π βΉLK23 πβΊ π' βΉLK_Ο23 π Ξ·' π'βΊ
by (intro LK_Ο23_is_ntcf prems assms)
show "β!Ο.
Ο : LK23 π β¦β©Cβ©F π' : cat_ordinal (3β©β) β¦β¦β©CβΞ±β π β§
Ξ·' = Ο ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π23 ββ©Nβ©Tβ©Cβ©F ntcf_id π"
proof(intro ex1I conjI; (elim conjE)?)
show "LK_Ο23 π Ξ·' π' : LK23 π β¦β©Cβ©F π' : cat_ordinal (3β©β) β¦β¦β©CβΞ±β π"
by (intro LK_Ο23.is_ntcf_axioms)
show "Ξ·' = LK_Ο23 π Ξ·' π' ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π23 ββ©Nβ©Tβ©Cβ©F ntcf_id π"
proof(rule ntcf_eqI)
show "Ξ·' : π β¦β©Cβ©F π' ββ©Cβ©F π23 : cat_ordinal (2β©β) β¦β¦β©CβΞ±β π"
by (intro prems)
then have dom_lhs: "πβ©β (Ξ·'β¦NTMapβ¦) = 2β©β"
by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
show rhs:
"LK_Ο23 π Ξ·' π' ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π23 ββ©Nβ©Tβ©Cβ©F ntcf_id π :
π β¦β©Cβ©F π' ββ©Cβ©F π23 : cat_ordinal (2β©β) β¦β¦β©CβΞ±β π"
by
(
cs_concl
cs_simp: cat_Kan_cs_simps cat_cs_simps
cs_intro: cat_Kan_cs_intros cat_cs_intros
)
then have dom_rhs:
"πβ©β ((LK_Ο23 π Ξ·' π' ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π23 ββ©Nβ©Tβ©Cβ©F ntcf_id π)β¦NTMapβ¦) = 2β©β"
by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
show "Ξ·'β¦NTMapβ¦ = (LK_Ο23 π Ξ·' π' ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π23 ββ©Nβ©Tβ©Cβ©F ntcf_id π)β¦NTMapβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix a assume prems: "a ββ©β 2β©β"
then consider βΉa = 0βΊ | βΉa = 1β©ββΊ unfolding two by auto
then show
"Ξ·'β¦NTMapβ¦β¦aβ¦ =
(LK_Ο23 π Ξ·' π' ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π23 ββ©Nβ©Tβ©Cβ©F ntcf_id π)β¦NTMapβ¦β¦aβ¦"
by (cases; use nothing in βΉsimp_all only:βΊ)
(
cs_concl
cs_simp:
omega_of_set
cat_Kan_cs_simps
cat_cs_simps
cat_ordinal_cs_simps
cs_intro: cat_Kan_cs_intros cat_cs_intros nat_omega_intros
)+
qed (use rhs in βΉcs_concl cs_simp: cs_intro: V_cs_intros cat_cs_introsβΊ)+
qed simp_all
fix Ο assume prems':
"Ο : LK23 π β¦β©Cβ©F π' : cat_ordinal (3β©β) β¦β¦β©CβΞ±β π"
"Ξ·' = Ο ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π23 ββ©Nβ©Tβ©Cβ©F ntcf_id π"
interpret Ο: is_ntcf Ξ± βΉcat_ordinal (3β©β)βΊ π βΉLK23 πβΊ π' Ο
by (rule prems'(1))
from prems'(2) have
"Ξ·'β¦NTMapβ¦β¦0β¦ = (Ο ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π23 ββ©Nβ©Tβ©Cβ©F ntcf_id π)β¦NTMapβ¦β¦0β¦"
by auto
then have [cat_cs_simps]: "Ξ·'β¦NTMapβ¦β¦0β¦ = Οβ¦NTMapβ¦β¦0β¦"
by
(
cs_prems
cs_simp: cat_Kan_cs_simps cat_cs_simps cat_ordinal_cs_simps
cs_intro: cat_cs_intros nat_omega_intros
)
from prems'(2) have
"Ξ·'β¦NTMapβ¦β¦1β©ββ¦ = (Ο ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π23 ββ©Nβ©Tβ©Cβ©F ntcf_id π)β¦NTMapβ¦β¦1β©ββ¦"
by auto
then have [cat_cs_simps]: "Ξ·'β¦NTMapβ¦β¦1β©ββ¦ = Οβ¦NTMapβ¦β¦2β©ββ¦"
by
(
cs_prems
cs_simp:
omega_of_set cat_Kan_cs_simps cat_cs_simps cat_ordinal_cs_simps
cs_intro: cat_cs_intros nat_omega_intros
)
show "Ο = LK_Ο23 π Ξ·' π'"
proof(rule ntcf_eqI)
show "Ο : LK23 π β¦β©Cβ©F π' : cat_ordinal (3β©β) β¦β¦β©CβΞ±β π"
by (rule prems'(1))
then have dom_lhs: "πβ©β (Οβ¦NTMapβ¦) = 3β©β"
by (cs_concl cs_simp: cat_cs_simps cat_ordinal_cs_simps)
show "LK_Ο23 π Ξ·' π' : LK23 π β¦β©Cβ©F π' : cat_ordinal (3β©β) β¦β¦β©CβΞ±β π"
by (cs_concl cs_simp: cs_intro: cat_cs_intros cat_Kan_cs_intros)
then have dom_rhs: "πβ©β (LK_Ο23 π Ξ·' π'β¦NTMapβ¦) = 3β©β"
by (cs_concl cs_simp: cat_cs_simps cat_ordinal_cs_simps)
from 0123 have 012: "[0, 1β©β]β©β : 0 β¦βcat_ordinal (2β©β)β 1β©β"
by (cs_concl cs_simp: cs_intro: cat_ordinal_cs_intros nat_omega_intros)
from 0123 have 013: "[0, 1β©β]β©β : 0 β¦βcat_ordinal (3β©β)β 1β©β"
by (cs_concl cs_simp: cs_intro: cat_ordinal_cs_intros nat_omega_intros)
from 0123 have 00: "[0, 0]β©β = (cat_ordinal (2β©β))β¦CIdβ¦β¦0β¦"
by (cs_concl cs_simp: cat_ordinal_cs_simps)
from Ο.ntcf_Comp_commute[OF 013] 013 0123
have [symmetric, cat_Kan_cs_simps]:
"Οβ¦NTMapβ¦β¦1β©ββ¦ = π'β¦ArrMapβ¦β¦0, 1β©ββ¦β©β ββ©Aβπβ Οβ¦NTMapβ¦β¦0β¦"
by
(
cs_prems
cs_simp: cat_cs_simps cat_Kan_cs_simps 00 LK23_ArrMap_app_01
cs_intro: cat_cs_intros cat_ordinal_cs_intros nat_omega_intros
)
show "Οβ¦NTMapβ¦ = LK_Ο23 π Ξ·' π'β¦NTMapβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix a assume prems: "a ββ©β 3β©β"
then consider βΉa = 0βΊ | βΉa = 1β©ββΊ | βΉa = 2β©ββΊ unfolding three by auto
then show "Οβ¦NTMapβ¦β¦aβ¦ = LK_Ο23 π Ξ·' π'β¦NTMapβ¦β¦aβ¦"
by (cases; use nothing in βΉsimp_all only:βΊ)
(
cs_concl
cs_simp: cat_ordinal_cs_simps cat_cs_simps cat_Kan_cs_simps
cs_intro: cat_cs_intros
)+
qed auto
qed simp_all
qed
qed (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)+
qed
subsectionβΉPointwise Kan extensions along βΉπ23βΊβΊ
lemma Ξ΅23_is_cat_pw_rKe:
assumes "π : cat_ordinal (2β©β) β¦β¦β©CβΞ±β π"
shows "ntcf_id π :
RK23 π ββ©Cβ©F π23 β¦β©Cβ©Fβ©.β©rβ©Kβ©eβ©.β©pβ©wβΞ±β π :
cat_ordinal (2β©β) β¦β©C cat_ordinal (3β©β) β¦β©C π"
proof-
interpret π: is_functor Ξ± βΉcat_ordinal (2β©β)βΊ π π by (rule assms(1))
show ?thesis
proof(intro is_cat_pw_rKeI Ξ΅23_is_cat_rKe[OF assms])
fix a assume prems: "a ββ©β πβ¦Objβ¦"
show
"ntcf_id π :
RK23 π ββ©Cβ©F π23 β¦β©Cβ©Fβ©.β©rβ©Kβ©eβΞ±β π :
cat_ordinal (2β©β) β¦β©C
cat_ordinal (3β©β) β¦β©C
(Homβ©Oβ©.β©CβΞ±βπ(a,-) : π β¦β¦β©C cat_Set Ξ±)"
proof(intro is_cat_rKe_preservesI Ξ΅23_is_cat_rKe[OF assms])
from prems show "Homβ©Oβ©.β©CβΞ±βπ(a,-) : π β¦β¦β©CβΞ±β cat_Set Ξ±"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ntcf_id π :
(Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F RK23 π) ββ©Cβ©F π23 β¦β©Cβ©Fβ©.β©rβ©Kβ©eβΞ±β Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F π :
cat_ordinal (2β©β) β¦β©C cat_ordinal (3β©β) β¦β©C cat_Set Ξ±"
proof(intro is_cat_rKeI')
show "π23 : cat_ordinal (2β©β) β¦β¦β©CβΞ±β cat_ordinal (3β©β)"
by (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros)
from prems show
"Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F RK23 π : cat_ordinal (3β©β) β¦β¦β©CβΞ±β cat_Set Ξ±"
by (cs_concl cs_simp: cs_intro: cat_cs_intros cat_Kan_cs_intros)
from prems show
"Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ntcf_id π :
Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F RK23 π ββ©Cβ©F π23 β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F π :
cat_ordinal (2β©β) β¦β¦β©CβΞ±β cat_Set Ξ±"
by
(
cs_concl
cs_simp: cat_cs_simps cat_Kan_cs_simps
cs_intro: cat_cs_intros cat_Kan_cs_intros
)
fix π' Ξ΅' assume prems':
"π' : cat_ordinal (3β©β) β¦β¦β©CβΞ±β cat_Set Ξ±"
"Ξ΅' :
π' ββ©Cβ©F π23 β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F π :
cat_ordinal (2β©β) β¦β¦β©CβΞ±β cat_Set Ξ±"
interpret π': is_functor Ξ± βΉcat_ordinal (3β©β)βΊ βΉcat_Set Ξ±βΊ π'
by (rule prems'(1))
interpret Ξ΅': is_ntcf
Ξ±
βΉcat_ordinal (2β©β)βΊ
βΉcat_Set Ξ±βΊ
βΉπ' ββ©Cβ©F π23βΊ
βΉHomβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F πβΊ
Ξ΅'
by (rule prems'(2))
show "β!Ο.
Ο :
π' β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F RK23 π :
cat_ordinal (3β©β) β¦β¦β©CβΞ±β cat_Set Ξ± β§
Ξ΅' = Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ntcf_id π ββ©Nβ©Tβ©Cβ©F (Ο ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π23)"
proof(intro ex1I conjI; (elim conjE)?)
have [cat_Kan_cs_simps]:
"Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F RK23 π = RK23 (Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F π)"
proof(rule cf_eqI)
from prems show lhs: "Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F RK23 π :
cat_ordinal (3β©β) β¦β¦β©CβΞ±β cat_Set Ξ±"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_Kan_cs_intros
)
from prems show rhs: "RK23 (Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F π) :
cat_ordinal (3β©β) β¦β¦β©CβΞ±β cat_Set Ξ±"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_Kan_cs_intros
)
from lhs prems have ObjMap_dom_lhs:
"πβ©β ((Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F RK23 π)β¦ObjMapβ¦) = 3β©β"
by
(
cs_concl
cs_simp: cat_ordinal_cs_simps cat_cs_simps
cs_intro: cat_Kan_cs_intros cat_cs_intros
)
from rhs prems have ObjMap_dom_rhs:
"πβ©β ((RK23 (Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F π))β¦ObjMapβ¦) = 3β©β"
by
(
cs_concl
cs_simp: cat_ordinal_cs_simps cat_cs_simps
cs_intro: cat_Kan_cs_intros
)
show
"(Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F RK23 π)β¦ObjMapβ¦ =
RK23 (Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F π)β¦ObjMapβ¦"
proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
fix c assume prems'': "c ββ©β 3β©β"
with 0123 consider βΉc = 0βΊ | βΉc = 1β©ββΊ | βΉc = 2β©ββΊ by force
from this prems prems'' 0123 show
"(Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F RK23 π)β¦ObjMapβ¦β¦cβ¦ =
RK23 (Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F π)β¦ObjMapβ¦β¦cβ¦"
by (cases; use nothing in βΉsimp_all only:βΊ)
(
cs_concl
cs_simp:
cat_ordinal_cs_simps
cat_cs_simps
cat_op_simps
cat_Kan_cs_simps
cs_intro: cat_Kan_cs_intros cat_cs_intros
)+
qed
(
use prems in βΉ
cs_concl cs_simp: cs_intro: cat_Kan_cs_intros cat_cs_intros
βΊ
)+
from lhs prems have ArrMap_dom_lhs:
"πβ©β ((Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F RK23 π)β¦ArrMapβ¦) =
cat_ordinal (3β©β)β¦Arrβ¦"
by
(
cs_concl
cs_simp: cat_ordinal_cs_simps cat_cs_simps
cs_intro: cat_Kan_cs_intros cat_cs_intros
)
from rhs prems have ArrMap_dom_rhs:
"πβ©β ((RK23 (Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F π))β¦ArrMapβ¦) =
cat_ordinal (3β©β)β¦Arrβ¦"
by
(
cs_concl
cs_simp: cat_ordinal_cs_simps cat_cs_simps
cs_intro: cat_Kan_cs_intros
)
show
"(Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F RK23 π)β¦ArrMapβ¦ =
RK23 (Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F π)β¦ArrMapβ¦"
proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
fix f assume prems'': "f ββ©β cat_ordinal (3β©β)β¦Arrβ¦"
then obtain a' b' where "f : a' β¦βcat_ordinal (3β©β)β b'" by auto
from this 0123 prems show
"(Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F RK23 π)β¦ArrMapβ¦β¦fβ¦ =
RK23 (Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F π)β¦ArrMapβ¦β¦fβ¦"
by
(
elim cat_ordinal_3_is_arrE;
use nothing in βΉsimp_all only:βΊ
)
(
cs_concl
cs_simp: cat_cs_simps cat_Kan_cs_simps cat_op_simps
cs_intro:
cat_ordinal_cs_intros
cat_Kan_cs_intros
cat_cs_intros
nat_omega_intros
)+
qed
(
use prems in
βΉcs_concl cs_simp: cs_intro: cat_Kan_cs_intros cat_cs_introsβΊ
)+
qed simp_all
show "RK_Ο23 (Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F π) Ξ΅' π' :
π' β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F RK23 π :
cat_ordinal (3β©β) β¦β¦β©CβΞ±β cat_Set Ξ±"
by (intro RK_Ο23_is_ntcf')
(cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)+
show "Ξ΅' =
Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F
ntcf_id π ββ©Nβ©Tβ©Cβ©F
(RK_Ο23 (Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F π) Ξ΅' π' ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π23)"
proof(rule ntcf_eqI)
show "Ξ΅' :
π' ββ©Cβ©F π23 β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F π :
cat_ordinal (2β©β) β¦β¦β©CβΞ±β cat_Set Ξ±"
by (intro prems')
then have dom_lhs: "πβ©β (Ξ΅'β¦NTMapβ¦) = 2β©β"
by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
from prems show
"Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F
ntcf_id π ββ©Nβ©Tβ©Cβ©F
(RK_Ο23 (Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F π) Ξ΅' π' ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π23) :
π' ββ©Cβ©F π23 β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F π :
cat_ordinal (2β©β) β¦β¦β©CβΞ±β cat_Set Ξ±"
by
(
cs_concl
cs_simp: cat_Kan_cs_simps
cs_intro: cat_Kan_cs_intros cat_cs_intros
)
then have dom_rhs:
"πβ©β
(
(Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F
ntcf_id π ββ©Nβ©Tβ©Cβ©F
(RK_Ο23 (Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F π) Ξ΅' π' ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π23)
)β¦NTMapβ¦) = 2β©β"
by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
show "Ξ΅'β¦NTMapβ¦ =
(
Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F
ntcf_id π ββ©Nβ©Tβ©Cβ©F
(RK_Ο23 (Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F π) Ξ΅' π' ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π23)
)β¦NTMapβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix c assume prems'': "c ββ©β 2β©β"
then consider βΉc = 0βΊ | βΉc = 1β©ββΊ unfolding two by auto
from this prems 0123 show "Ξ΅'β¦NTMapβ¦β¦cβ¦ =
(
Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F
ntcf_id π ββ©Nβ©Tβ©Cβ©F
(RK_Ο23 (Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F π) Ξ΅' π' ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π23)
)β¦NTMapβ¦β¦cβ¦"
by (cases; use nothing in βΉsimp_all only:βΊ)
(
cs_concl
cs_simp:
cat_Kan_cs_simps
cat_ordinal_cs_simps
cat_cs_simps
cat_op_simps
cat_Set_components(1)
cs_intro:
cat_Kan_cs_intros
cat_cs_intros
cat_prod_cs_intros
π.HomCod.cat_Hom_in_Vset
)+
qed (cs_concl cs_simp: cs_intro: cat_cs_intros V_cs_intros)+
qed simp_all
fix Ο assume prems'':
"Ο :
π' β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F RK23 π :
cat_ordinal (3β©β) β¦β¦β©CβΞ±β cat_Set Ξ±"
"Ξ΅' =
Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ntcf_id π ββ©Nβ©Tβ©Cβ©F (Ο ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π23)"
interpret Ο: is_ntcf
Ξ± βΉcat_ordinal (3β©β)βΊ βΉcat_Set Ξ±βΊ π' βΉHomβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F RK23 πβΊ Ο
by (rule prems''(1))
from prems''(2) have "Ξ΅'β¦NTMapβ¦β¦0β¦ =
(Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ntcf_id π ββ©Nβ©Tβ©Cβ©F (Ο ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π23))β¦NTMapβ¦β¦0β¦"
by auto
from this prems 0123 have Ξ΅'_NTMap_app_0: "Ξ΅'β¦NTMapβ¦β¦0β¦ = Οβ¦NTMapβ¦β¦0β¦"
by
(
cs_prems
cs_simp:
cat_ordinal_cs_simps
cat_cs_simps
cat_Kan_cs_simps
cat_op_simps
π23_ObjMap_app_0
cat_Set_components(1)
cs_intro:
cat_Kan_cs_intros
cat_cs_intros
cat_prod_cs_intros
π.HomCod.cat_Hom_in_Vset
)
from 0123 have 01: "[0, 1β©β]β©β : 0 β¦βcat_ordinal (2β©β)β 1β©β"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_ordinal_cs_intros nat_omega_intros
)
from prems''(2) have
"Ξ΅'β¦NTMapβ¦β¦1β©ββ¦ =
(
Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F
ntcf_id π ββ©Nβ©Tβ©Cβ©F
(Ο ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π23)
)β¦NTMapβ¦β¦1β©ββ¦"
by auto
from this prems 0123 have Ξ΅'_NTMap_app_1:
"Ξ΅'β¦NTMapβ¦β¦1β©ββ¦ = Οβ¦NTMapβ¦β¦2β©ββ¦"
by
(
cs_prems
cs_simp:
cat_ordinal_cs_simps
cat_cs_simps
cat_Kan_cs_simps
cat_op_simps
π23_ObjMap_app_1
cat_Set_components(1)
cs_intro:
cat_Kan_cs_intros
cat_cs_intros
cat_prod_cs_intros
π.HomCod.cat_Hom_in_Vset
)
from 0123 have 012: "[0, 1β©β]β©β : 0 β¦βcat_ordinal (2β©β)β 1β©β"
by
(
cs_concl cs_simp: cs_intro:
cat_ordinal_cs_intros nat_omega_intros
)
from 0123 have 013: "[0, 1β©β]β©β : 0 β¦βcat_ordinal (3β©β)β 1β©β"
by
(
cs_concl cs_simp: cs_intro:
cat_ordinal_cs_intros nat_omega_intros
)
from 0123 have 123: "[1β©β, 2β©β]β©β : 1β©β β¦βcat_ordinal (3β©β)β 2β©β"
by
(
cs_concl cs_simp: cs_intro:
cat_ordinal_cs_intros nat_omega_intros
)
from 0123 have 11: "[1β©β, 1β©β]β©β = (cat_ordinal (2β©β))β¦CIdβ¦β¦1β©ββ¦"
by (cs_concl cs_simp: cat_ordinal_cs_simps)
from Ο.ntcf_Comp_commute[OF 123] prems 012 013
have [cat_Kan_cs_simps]:
"Ξ΅'β¦NTMapβ¦β¦1β©ββ¦ ββ©Aβcat_Set Ξ±β π'β¦ArrMapβ¦β¦1β©β, 2β©ββ¦β©β = Οβ¦NTMapβ¦β¦1β©ββ¦"
by
(
cs_prems 1
cs_simp:
cat_cs_simps
cat_Kan_cs_simps
Ξ΅'_NTMap_app_1[symmetric]
is_functor.cf_ObjMap_CId
RK23_ArrMap_app_12
11
cs_intro: cat_cs_intros nat_omega_intros
)
show "Ο = RK_Ο23 (Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F π) Ξ΅' π'"
proof(rule ntcf_eqI)
show Ο: "Ο :
π' β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F RK23 π :
cat_ordinal (3β©β) β¦β¦β©CβΞ±β cat_Set Ξ±"
by (rule prems''(1))
then have dom_lhs: "πβ©β (Οβ¦NTMapβ¦) = 3β©β"
by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
show "RK_Ο23 (Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F π) Ξ΅' π' :
π' β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F RK23 π :
cat_ordinal (3β©β) β¦β¦β©CβΞ±β cat_Set Ξ±"
by
(
cs_concl
cs_simp: cat_Kan_cs_simps
cs_intro: cat_Kan_cs_intros cat_cs_intros
)
then have dom_rhs:
"πβ©β (RK_Ο23 (Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F π) Ξ΅' π'β¦NTMapβ¦) = 3β©β"
by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
show "Οβ¦NTMapβ¦ = RK_Ο23 (Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F π) Ξ΅' π'β¦NTMapβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix c assume "c ββ©β 3β©β"
then consider βΉc = 0βΊ | βΉc = 1β©ββΊ | βΉc = 2β©ββΊ
unfolding three by auto
from this 0123 show
"Οβ¦NTMapβ¦β¦cβ¦ = RK_Ο23 (Homβ©Oβ©.β©CβΞ±βπ(a,-) ββ©Cβ©F π) Ξ΅' π'β¦NTMapβ¦β¦cβ¦"
by (cases; use nothing in βΉsimp_all only:βΊ)
(
cs_concl cs_simp:
cat_Kan_cs_simps Ξ΅'_NTMap_app_1 Ξ΅'_NTMap_app_0
)+
qed (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros V_cs_intros)+
qed simp_all
qed
qed
qed
qed
qed
lemma Ξ·23_is_cat_pw_lKe:
assumes "π : cat_ordinal (2β©β) β¦β¦β©CβΞ±β π"
shows "ntcf_id π :
π β¦β©Cβ©Fβ©.β©lβ©Kβ©eβ©.β©pβ©wβΞ±β LK23 π ββ©Cβ©F π23 :
cat_ordinal (2β©β) β¦β©C cat_ordinal (3β©β) β¦β©C π"
proof-
interpret π: is_functor Ξ± βΉcat_ordinal (2β©β)βΊ π π by (rule assms(1))
from ord_of_nat_Ο interpret cat_ordinal_3: finite_category Ξ± βΉcat_ordinal (3β©β)βΊ
by (cs_concl cs_intro: cat_ordinal_cs_intros)
from 0123 have 002: "[0, 0]β©β : 0 β¦βcat_ordinal (2β©β)β 0"
by (cs_concl cs_simp: cat_ordinal_cs_simps cs_intro: cat_cs_intros)
show ?thesis
proof(intro is_cat_pw_lKeI Ξ·23_is_cat_rKe assms, unfold cat_op_simps)
fix a assume prems: "a ββ©β πβ¦Objβ¦"
show
"op_ntcf (ntcf_id π) :
op_cf (LK23 π) ββ©Cβ©F op_cf π23 β¦β©Cβ©Fβ©.β©rβ©Kβ©eβΞ±β op_cf π :
op_cat (cat_ordinal (2β©β)) β¦β©C op_cat (cat_ordinal (3β©β)) β¦β©C
(Homβ©Oβ©.β©CβΞ±βπ(-,a) : op_cat π β¦β¦β©C cat_Set Ξ±)"
proof(intro is_cat_rKe_preservesI)
show
"op_ntcf (ntcf_id π) :
op_cf (LK23 π) ββ©Cβ©F op_cf π23 β¦β©Cβ©Fβ©.β©rβ©Kβ©eβΞ±β op_cf π :
op_cat (cat_ordinal (2β©β)) β¦β©C op_cat (cat_ordinal (3β©β)) β¦β©C op_cat π"
proof(cs_intro_step cat_op_intros)
show "ntcf_id π :
π β¦β©Cβ©Fβ©.β©lβ©Kβ©eβΞ±β LK23 π ββ©Cβ©F π23 :
cat_ordinal (2β©β) β¦β©C cat_ordinal (3β©β) β¦β©C π"
by (intro Ξ·23_is_cat_rKe assms)
qed simp_all
from prems show "Homβ©Oβ©.β©CβΞ±βπ(-,a) : op_cat π β¦β¦β©CβΞ±β cat_Set Ξ±"
by (cs_concl cs_simp: cs_intro: cat_cs_intros)
have
"op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ntcf_id π :
op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©F π β¦β©Cβ©Fβ©.β©lβ©Kβ©eβΞ±β
(op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©F LK23 π) ββ©Cβ©F π23 :
cat_ordinal (2β©β) β¦β©C cat_ordinal (3β©β) β¦β©C op_cat (cat_Set Ξ±)"
proof(intro is_cat_lKeI')
show "π23 : cat_ordinal (2β©β) β¦β¦β©CβΞ±β cat_ordinal (3β©β)"
by (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros)
from prems show "op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©F LK23 π :
cat_ordinal (3β©β) β¦β¦β©CβΞ±β op_cat (cat_Set Ξ±)"
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_Kan_cs_intros cat_cs_intros cat_op_intros
)
from prems show
"op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ntcf_id π :
op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©F π β¦β©Cβ©F
op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©F LK23 π ββ©Cβ©F π23 :
cat_ordinal (2β©β) β¦β¦β©CβΞ±β op_cat (cat_Set Ξ±)"
by
(
cs_concl
cs_simp: cat_cs_simps cat_Kan_cs_simps cat_op_simps
cs_intro: cat_Kan_cs_intros cat_cs_intros cat_op_intros
)
fix π' Ξ·' assume prems':
"π' : cat_ordinal (3β©β) β¦β¦β©CβΞ±β op_cat (cat_Set Ξ±)"
"Ξ·' :
op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©F π β¦β©Cβ©F π' ββ©Cβ©F π23 :
cat_ordinal (2β©β) β¦β¦β©CβΞ±β op_cat (cat_Set Ξ±)"
interpret π': is_functor Ξ± βΉcat_ordinal (3β©β)βΊ βΉop_cat (cat_Set Ξ±)βΊ π'
by (rule prems'(1))
interpret Ξ·': is_ntcf
Ξ±
βΉcat_ordinal (2β©β)βΊ
βΉop_cat (cat_Set Ξ±)βΊ
βΉop_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©F πβΊ
βΉπ' ββ©Cβ©F π23βΊ
Ξ·'
by (rule prems'(2))
note [unfolded cat_op_simps, cat_cs_intros] =
Ξ·'.ntcf_NTMap_is_arr'
π'.cf_ArrMap_is_arr'
show
"β!Ο.
Ο :
op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©F LK23 π β¦β©Cβ©F π' :
cat_ordinal (3β©β) β¦β¦β©CβΞ±β op_cat (cat_Set Ξ±) β§
Ξ·' = Ο ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π23 ββ©Nβ©Tβ©Cβ©F (op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ntcf_id π)"
proof(intro ex1I conjI; (elim conjE)?)
have [cat_Kan_cs_simps]:
"op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©F LK23 π =
LK23 (op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©F π)"
proof(rule cf_eqI)
from prems show lhs: "op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©F LK23 π :
cat_ordinal (3β©β) β¦β¦β©CβΞ±β op_cat (cat_Set Ξ±)"
by
(
cs_concl
cs_simp: cat_op_simps
cs_intro: cat_Kan_cs_intros cat_cs_intros cat_op_intros
)
from prems show rhs: "LK23 (op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©F π) :
cat_ordinal (3β©β) β¦β¦β©CβΞ±β op_cat (cat_Set Ξ±)"
by (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros cat_cs_intros)
from lhs prems have ObjMap_dom_lhs:
"πβ©β ((op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©F LK23 π)β¦ObjMapβ¦) = 3β©β"
by
(
cs_concl
cs_simp: cat_ordinal_cs_simps cat_cs_simps cat_op_simps
cs_intro: cat_Kan_cs_intros cat_cs_intros
)
from rhs prems have ObjMap_dom_rhs:
"πβ©β (LK23 (op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©F π)β¦ObjMapβ¦) = 3β©β"
by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
show
"(op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©F LK23 π)β¦ObjMapβ¦ =
LK23 (op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©F π)β¦ObjMapβ¦"
proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
fix c assume prems'': "c ββ©β 3β©β"
then consider βΉc = 0βΊ | βΉc = 1β©ββΊ | βΉc = 2β©ββΊ
unfolding three by auto
from this prems 0123 show
"(op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©F LK23 π)β¦ObjMapβ¦β¦cβ¦ =
LK23 (op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©F π)β¦ObjMapβ¦β¦cβ¦"
by (cases; use nothing in βΉsimp_all only:βΊ)
(
cs_concl
cs_simp:
cat_ordinal_cs_simps
cat_Kan_cs_simps
cat_cs_simps
cat_op_simps
cs_intro: cat_Kan_cs_intros cat_cs_intros cat_op_intros
)+
qed
(
use prems in
βΉ
cs_concl
cs_simp: cat_op_simps
cs_intro: cat_Kan_cs_intros cat_cs_intros cat_op_intros
βΊ
)+
from lhs prems have ArrMap_dom_lhs:
"πβ©β ((op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©F LK23 π)β¦ArrMapβ¦) =
cat_ordinal (3β©β)β¦Arrβ¦"
by
(
cs_concl
cs_simp: cat_ordinal_cs_simps cat_cs_simps cat_op_simps
cs_intro: cat_Kan_cs_intros cat_cs_intros
)
from rhs prems have ArrMap_dom_rhs:
"πβ©β (LK23 (op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©F π)β¦ArrMapβ¦) =
cat_ordinal (3β©β)β¦Arrβ¦"
by (cs_concl cs_simp: cat_cs_simps)
show
"(op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©F LK23 π)β¦ArrMapβ¦ =
LK23 (op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©F π)β¦ArrMapβ¦"
proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
fix f assume "f ββ©β cat_ordinal (3β©β)β¦Arrβ¦"
then obtain a' b' where f: "f : a' β¦βcat_ordinal (3β©β)β b'"
by auto
from f prems 0123 002 show
"(op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©F LK23 π)β¦ArrMapβ¦β¦fβ¦ =
LK23 (op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©F π)β¦ArrMapβ¦β¦fβ¦"
by (elim cat_ordinal_3_is_arrE, (simp_all only:)?)
(
cs_concl
cs_simp: cat_cs_simps cat_Kan_cs_simps cat_op_simps
cs_intro:
cat_ordinal_cs_intros
cat_Kan_cs_intros
cat_cs_intros
cat_op_intros
nat_omega_intros
)+
qed
(
use prems in
βΉ
cs_concl
cs_simp: cat_op_simps
cs_intro: cat_Kan_cs_intros cat_cs_intros cat_op_introsβΊ
)+
qed simp_all
show "LK_Ο23 (op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©F π) Ξ·' π' :
op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©F LK23 π β¦β©Cβ©F π' :
cat_ordinal (3β©β) β¦β¦β©CβΞ±β op_cat (cat_Set Ξ±)"
by
(
cs_concl
cs_simp: cat_cs_simps cat_Kan_cs_simps cat_op_simps
cs_intro: cat_Kan_cs_intros cat_cs_intros cat_op_intros
)
show "Ξ·' =
LK_Ο23
(
op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©F π) Ξ·' π' ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F
π23 ββ©Nβ©Tβ©Cβ©F
(op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ntcf_id π
)"
proof(rule ntcf_eqI)
show lhs: "Ξ·' :
op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©F π β¦β©Cβ©F π' ββ©Cβ©F π23 :
cat_ordinal (2β©β) β¦β¦β©CβΞ±β op_cat (cat_Set Ξ±)"
by (rule prems'(2))
from lhs have "πβ©β (Ξ·'β¦NTMapβ¦) = cat_ordinal (2β©β)β¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps)
from prems show rhs:
"LK_Ο23
(
op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©F π) Ξ·' π' ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F
π23 ββ©Nβ©Tβ©Cβ©F
(op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ntcf_id π
) :
op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©F π β¦β©Cβ©F π' ββ©Cβ©F π23 :
cat_ordinal (2β©β) β¦β¦β©CβΞ±β op_cat (cat_Set Ξ±)"
by
(
cs_concl
cs_simp: cat_Kan_cs_simps cat_op_simps
cs_intro: cat_Kan_cs_intros cat_cs_intros cat_op_intros
)
from lhs have dom_lhs: "πβ©β (Ξ·'β¦NTMapβ¦) = 2β©β"
by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
from rhs have dom_rhs: "πβ©β ((LK_Ο23
(
op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©F π) Ξ·' π' ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F
π23 ββ©Nβ©Tβ©Cβ©F
(op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ntcf_id π
))β¦NTMapβ¦) = 2β©β"
by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
show
"Ξ·'β¦NTMapβ¦ =
(
LK_Ο23
(
op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©F π) Ξ·' π' ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F
π23 ββ©Nβ©Tβ©Cβ©F
(op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ntcf_id π
)
)β¦NTMapβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs cat_ordinal_cs_simps)
fix c assume "c ββ©β 2β©β"
then consider βΉc = 0βΊ | βΉc = 1β©ββΊ unfolding two by auto
from this prems 0123 show
"Ξ·'β¦NTMapβ¦β¦cβ¦ =
(
LK_Ο23 (op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©F π) Ξ·' π' ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F
π23 ββ©Nβ©Tβ©Cβ©F (op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ntcf_id π)
)β¦NTMapβ¦β¦cβ¦"
by (cases, use nothing in βΉsimp_all only:βΊ)
(
cs_concl
cs_simp:
cat_ordinal_cs_simps
cat_Kan_cs_simps
cat_cs_simps
cat_op_simps
π23_ObjMap_app_1
π23_ObjMap_app_0
LK_Ο23_NTMap_app_0
cat_Set_components(1)
cs_intro:
cat_Kan_cs_intros
cat_cs_intros
cat_prod_cs_intros
cat_op_intros
π.HomCod.cat_Hom_in_Vset
)+
qed (cs_concl cs_simp: cs_intro: V_cs_intros cat_cs_intros)+
qed simp_all
fix Ο assume prems'':
"Ο :
op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©F LK23 π β¦β©Cβ©F π' :
cat_ordinal (3β©β) β¦β¦β©CβΞ±β op_cat (cat_Set Ξ±)"
"Ξ·' = Ο ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π23 ββ©Nβ©Tβ©Cβ©F (op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ntcf_id π)"
interpret Ο: is_ntcf
Ξ±
βΉcat_ordinal (3β©β)βΊ βΉop_cat (cat_Set Ξ±)βΊ
βΉop_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©F LK23 πβΊ
π'
Ο
by (rule prems''(1))
note [cat_Kan_cs_intros] = Ο.ntcf_NTMap_is_arr'[unfolded cat_op_simps]
from prems''(2) have
"Ξ·'β¦NTMapβ¦β¦0β¦ =
(
Ο ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F
π23 ββ©Nβ©Tβ©Cβ©F
(op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ntcf_id π)
)β¦NTMapβ¦β¦0β¦"
by simp
from this prems 0123 have Ξ·'_NTMap_app_0: "Ξ·'β¦NTMapβ¦β¦0β¦ = Οβ¦NTMapβ¦β¦0β¦"
by
(
cs_prems
cs_simp:
cat_ordinal_cs_simps
cat_Kan_cs_simps
cat_cs_simps
cat_op_simps
cat_Set_components(1)
cs_intro:
cat_Kan_cs_intros
cat_cs_intros
cat_prod_cs_intros
cat_op_intros
π.HomCod.cat_Hom_in_Vset
)
from prems''(2) have
"Ξ·'β¦NTMapβ¦β¦1β©ββ¦ =
(
Ο ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F
π23 ββ©Nβ©Tβ©Cβ©F
(op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ntcf_id π)
)β¦NTMapβ¦β¦1β©ββ¦"
by simp
from this prems 0123 have Ξ·'_NTMap_app_1: "Ξ·'β¦NTMapβ¦β¦1β©ββ¦ = Οβ¦NTMapβ¦β¦2β©ββ¦"
by
(
cs_prems
cs_simp:
cat_ordinal_cs_simps
cat_Kan_cs_simps
cat_cs_simps
cat_op_simps
cat_Set_components(1)
cs_intro:
cat_Kan_cs_intros
cat_cs_intros
cat_prod_cs_intros
cat_op_intros
π.HomCod.cat_Hom_in_Vset
)+
from 0123 have 013: "[0, 1β©β]β©β : 0 β¦βcat_ordinal (3β©β)β 1β©β"
by (cs_concl cs_simp: cs_intro: cat_ordinal_cs_intros nat_omega_intros)
from 0123 have 00: "[0, 0]β©β = (cat_ordinal (2β©β))β¦CIdβ¦β¦0β¦"
by (cs_concl cs_simp: cat_ordinal_cs_simps)
from Ο.ntcf_Comp_commute[OF 013] prems 0123 013
have [cat_Kan_cs_simps]:
"Οβ¦NTMapβ¦β¦1β©ββ¦ = Ξ·'β¦NTMapβ¦β¦0β¦ ββ©Aβcat_Set Ξ±β π'β¦ArrMapβ¦β¦0, 1β©ββ¦β©β"
by
(
cs_prems
cs_simp:
cat_ordinal_cs_simps
cat_Kan_cs_simps
cat_cs_simps
cat_op_simps
LK23_ArrMap_app_01
cs_intro:
cat_ordinal_cs_intros
cat_Kan_cs_intros
cat_cs_intros
cat_prod_cs_intros
cat_op_intros
nat_omega_intros
cs_simp: 00 Ξ·'_NTMap_app_0[symmetric]
)
show "Ο = LK_Ο23 (op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©F π) Ξ·' π'"
proof(rule ntcf_eqI)
show lhs: "Ο :
op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©F LK23 π β¦β©Cβ©F π' :
cat_ordinal (3β©β) β¦β¦β©CβΞ±β op_cat (cat_Set Ξ±)"
by (rule prems''(1))
show rhs: "LK_Ο23 (op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©F π) Ξ·' π' :
op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©F LK23 π β¦β©Cβ©F π' :
cat_ordinal (3β©β) β¦β¦β©CβΞ±β op_cat (cat_Set Ξ±)"
by
(
cs_concl
cs_simp: cat_Kan_cs_simps
cs_intro: cat_Kan_cs_intros cat_cs_intros
)
from lhs have dom_lhs: "πβ©β (Οβ¦NTMapβ¦) = 3β©β"
by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
from rhs have dom_rhs:
"πβ©β (LK_Ο23 (op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©F π) Ξ·' π'β¦NTMapβ¦) = 3β©β"
by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
show "Οβ¦NTMapβ¦ = LK_Ο23 (op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©F π) Ξ·' π'β¦NTMapβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix c assume "c ββ©β 3β©β"
then consider βΉc = 0βΊ | βΉc = 1β©ββΊ | βΉc = 2β©ββΊ
unfolding three by auto
from this 0123 show
"Οβ¦NTMapβ¦β¦cβ¦ =
LK_Ο23 (op_cf Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©F π) Ξ·' π'β¦NTMapβ¦β¦cβ¦"
by (cases, use nothing in βΉsimp_all only:βΊ)
(
cs_concl
cs_simp:
cat_ordinal_cs_simps
cat_cs_simps
cat_Kan_cs_simps
cat_op_simps
Ξ·'_NTMap_app_0
LK_Ο23_NTMap_app_0
Ξ·'_NTMap_app_1
cs_intro:
cat_ordinal_cs_intros
cat_Kan_cs_intros
cat_cs_intros
cat_op_intros
nat_omega_intros
)+
qed (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros V_cs_intros)+
qed simp_all
qed
qed
then have
"op_ntcf (Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F op_ntcf (ntcf_id π)) :
op_cf (Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©F op_cf π) β¦β©Cβ©Fβ©.β©lβ©Kβ©eβΞ±β
op_cf ((Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©F op_cf (LK23 π))) ββ©Cβ©F op_cf (op_cf π23) :
op_cat (op_cat (cat_ordinal (2β©β))) β¦β©C
op_cat (op_cat (cat_ordinal (3β©β))) β¦β©C
op_cat (cat_Set Ξ±)"
by
(
cs_concl
cs_simp: cat_op_simps
cs_intro: cat_cs_intros cat_Kan_cs_intros cat_op_intros
)
from is_cat_lKe.is_cat_rKe_op[OF this] prems show
"Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F op_ntcf (ntcf_id π) :
(Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©F op_cf (LK23 π)) ββ©Cβ©F op_cf π23 β¦β©Cβ©Fβ©.β©rβ©Kβ©eβΞ±β
Homβ©Oβ©.β©CβΞ±βπ(-,a) ββ©Cβ©F op_cf π :
op_cat (cat_ordinal (2β©β)) β¦β©C
op_cat (cat_ordinal (3β©β)) β¦β©C
cat_Set Ξ±"
by
(
cs_prems
cs_simp: cat_op_simps
cs_intro: cat_Kan_cs_intros cat_cs_intros cat_op_intros
)
qed
qed
qed
textβΉ\newpageβΊ
end